9:25 AM  8-MAY-99
AVA v 93.2 Patch 11.  Disable 'AD' x-ref on file 4.  Restore 5 routines and DO ^AVAP11.
A9AVA11
A9AVA11 ; IHS/ASDST/GTH - RPI FOR AVA 93.2 PATCH 11 ; [ 05/03/1999  4:39 PM ]
 ;;93.2;VA SUPPORT FILES;**11**;JUL 01, 1993
 ;
 G UPDATEDD^AVAP11
 ;

AVA200
AVA200 ; IHS/ADC/CRG - ADD/ EDIT PERSONS TO VA(200 ; 27-MAY-1993 [ 12/05/96  11:19 AM ]
 ;;93.2;VA SUPPORT FILES;**1,4,7,8**;JUL 01, 1993
 ;PATCH #8 -- Added Service/Section field to Add New Person-IHS/ADC/CRG
 ;
 Q
PERADD ;EP; ENTRY POINT to add or edit persons in ^va(200
 W @IOF,!!?22,"ADD/EDIT NEW PERSONS",!!
 W !!?10,"Use this option to enter names of employees, contractors, "
 W !?5,"and volunteers who will be referenced by other software.  If"
 W !?5,"the person is also a provider, you do NOT need to use this "
 W !?5,"option as the ADD/EDIT PROVIDERS option includes the data"
 W !?5,"fields asked for here.",!!
 ;
PER1 S AVAX=$$PERSON G PER1:AVAX>0
 K AVAX Q
 ;
 ;
PRVADD ;EP;ENTRY POINT to add or edit providers in ^va(200
 W @IOF,!!?22,"ADD/EDIT PROVIDERS",!!
 W !!?10,"Use this option to add new providers to your system OR to"
 W !?5,"edit those already in the system.  You do NOT need to enter the"
 W !?5,"provider as a person first.  Just use this option.",!
 ;
PRV1 S AVAX=$$PROVIDER G PRV1:AVAX>0
 K AVAX Q
 ;         
 ;
INACTIVE ;PEP;ENTRY POINT to inactivate a person and/or provider
 W @IOF,!!?20,"INACTIVATE/REACTIVATE A PERSON/PROVIDER",!!
 W !!?10,"Use this option to enter an INACTIVE DATE for a Person" ;PATCH #7
 W !?5,"or Provider.  To deactivate a user, please use the option on"
 W !?5,"the USER EDIT menu.  To REACTIVATE a person or provider, enter"
 W !?5,"an ""@"" at the Inactive Date prompt.  Then proceed to the" ;PATCH #7
 W !?5,"ADD/EDIT PROVIDERS option to insure all the data is current."
 W !!
 ;
ASK W !! K DIC S DIC=200,DIC(0)="AEMZQ" D ^DIC G INEXIT:Y=-1
 W ! S DIE=200,DA=+Y,DR="53.4" D ^DIE ;PATCH #7
 G ASK
 ;
INEXIT K DIC,DIE,DR,DA,X,Y Q
 ;
 ;
 ;
PERSON(AVADR,AVADR1) ;PEP;EXTR FUNC called to perform add or edit on one person
 ;AVADR can be set to fields to add as identifiers
 ;AVADR1 can be set to additional fields for DIE call
 ;to call, set variable to $$PERSON(with optional parameters)
 ;Identifiers already included:  by VA: Initials, SSN, Sex
 ;DR string below includes: VA Identifiers plus those you sent
 ;   Plus those stated below: DOB, Address fields, Phone, Office Phone
 ;
 N DIE,DA,DR,AVADA S AVADR=$G(AVADR)
 W ! S AVADA=$$ADD^XUSERNEW(AVADR) G EXIT1:AVADA'>0
 I $P(AVADA,U,3)=1 W !,"Identifiers Completed. Now for other data fields"
 I $P($G(^VA(200,+AVADA,"PS")),U,4)]"" W !!,$P(AVADA,U,2)," has been INACTIVATED.  Please use the INACTIVATE/REACTIVATE option.",!! G EXIT1 ;PATCH #7
 W ! S DIE=200,DA=+AVADA
 ;S DR=".01;1;4;5;8;9;.111:.116;.131;.132" S:$D(AVADR1) DR=DR_";"_AVADR1 ;PATCH #7
 S DR=".01;1;4;5;8;9;29;.111:.116;.131;.132" S:$D(AVADR1) DR=DR_";"_AVADR1 ;PATCH #7,8 ;IHS/ADC/CRG 12/4/96
 D ^DIE
EXIT1 Q AVADA
 ;
 ;
PROVIDER(AVADR,AVADR1) ;PEP;EXTR FUNC called to add or edit one provider
 ;AVADR can be set to fields to add as identifiers
 ;AVADR1 can be set to additional fields for DR for ^DIE call
 ;to call, set variable to $$PROVIDER(with optional parameters)
 ;Identifiers already included:  by VA: Initials, SSN, Sex
 ;  By variable X set below: Affiliation, Provider Class, Code
 ;DR string includes: VA Identifiers plus those you sent to $$PROVIDER
 ;   Plus identifiers stated below in X
 ;   Plus those stated in $$PERSON: DOB, Address, Phone #
 ;   Plus those set into Y below: IHS Local Code, Medicare & Medicaid #,
 ;         UPIN #, and all VA provider fields except VA #
 ;
 N Y,X
 S X="53.5R;9999999.01;9999999.02" S:$D(AVADR) X=X_";"_AVADR ;IHS/ORDC/LJF 12/3/93 PATCH #4
 S Y=X_";9999999.05:9999999.08;53.1;53.2;53.6:53.9" ;PATCH #7
 S:$D(AVADR1) Y=Y_";"_AVADR1
 S AVADA=$$PERSON(X,Y)
 I $P($G(^VA(200,+AVADA,"PS")),U,5)]"" D  ;IHS/ORDC/LJF 9/13/93 PATCH #1
 .S DA=$P(^DIC(3,+AVADA,0),U,16) ;IHS/ORDC/LJF 9/13/93 PATCH #1
 .I DA S DIE=6,DR="9999999.21" D ^DIE ;IHS/ORDC/LJF 9/13/93 PATCH #1
 I +AVADA>0,$P($G(^VA(200,+AVADA,"PS")),U,5)="" W !!,*7,"MUST HAVE PROVIDER CLASS TO BE DESIGNATED AS A PROVIDER!!",!
 Q AVADA

AVAP10
AVAP10 ;IHS/ASDST/GTH - CORRECT GIHS XREF FROM 200 TO 6 ; [ 02/24/1999  1:45 PM ]
 ;;93.2;VA SUPPORT FILES;**10**;JUL 01, 1993
 ;
 S U="^"
 W !!!,"This is Patch 10 to AVA 93.2."
 W !!,"A correction will be made to the File 200 dd, Field 9999999.09,"
 W !,"which does not correctly set the GIHS x-ref on File 6."
 W !!,"Then, the x-ref will be fired for all entries in File 200, which"
 W !,"will correctly set the GIHS x-ref on File 6."
 W !!,"Based on your ",$P(^VA(200,0),U,4)," entries in File 200,"
 W !,"this should take about ",$FN($P(^VA(200,0),U,4)/100/60,"",2)," minutes."
 W !!,"Re-running this patch causes no harm."
 W !!
 NEW DIR
 S DIR(0)="YO",DIR("B")="NO"
 S DIR("A")="OKAY to run Patch 10"
 D ^DIR
 KILL DIR
 G:Y'=1 EOJ
 D WAIT^DICD
 ;
UPDATEDD ;
 W !,"Updating dd..."
 NEW DA
 F %=1:1 Q:'$D(^DD(200,9999999.09,1,%))  I $P(^(%,0),"^",2)="ACXIHS09" S DA=% Q
 I '$D(DA) W !,"X-REF 'ACXIHS09' not found in File 200, Field 9999999.09.",!,"Abnormal end of Patch 10!" G EOJ
 ;
 I '(^DD(200,9999999.09,1,DA,1)=$P($T(OLDSET),";",3)) W !,"You don't have the standard SET of the ACXIHS09 x-ref.",!,"Ending Patch 10 without updating." G EOJ
 ;
 I '(^DD(200,9999999.09,1,DA,2)=$P($T(OLDKILL),";",3)) W !,"You don't have the standard KILL of the ACXIHS09 x-ref.",!,"Ending Patch 10 without updating." G EOJ
 ;
 W !,"Updating SET of x-ref 'ACXIHS09'..."
 S ^DD(200,9999999.09,1,DA,1)=$P($T(SET),";",3)
 W "Done updating SET."
 ;
 W !,"Updating KILL of x-ref 'ACXIHS09'..."
 S ^DD(200,9999999.09,1,DA,2)=$P($T(KILL),";",3)
 W "Done updating KILL."
 ;
 S ^DD(200,9999999.09,"DT")=$$DT^XLFDT
 KILL DA
 ;
 W !,"dd update complete."
 ;
XREF ;
 W !!,"Beginning re-index of File 200, Field 9999999.09, x-ref 'ACXIHS09'..."
 NEW DIK
 S DIK="^VA(200,",DIK(1)="9999999.09^ACXIHS09"
 D ENALL^DIK
 KILL DIK
 W !,"Re-index complete."
 ;
 W !!,"Patch 10 to AVA 93.2 is complete.",!
 ;
EOJ ;     
 KILL DIC,DIR,DIE,DA,DR,X,Y
 Q
 ;
SET ;;N % S %=$P(^DIC(3,DA,0),U,16) I %]"" S:'$D(^DIC(6,%,9999999)) ^DIC(6,%,9999999)="" S $P(^(9999999),U,9)=X,^DIC(6,"GIHS",X,%)=""
 ;
KILL ;;N % S %=$P(^DIC(3,DA,0),U,16) I %]"",$D(^DIC(6,%,9999999)) S $P(^(9999999),U,9)="" K ^DIC(6,"GIHS",X,%)
 ;
OLDSET ;;N % S %=$P(^DIC(3,DA,0),U,16) I %]"" S:'$D(^DIC(6,%,9999999)) ^DIC(6,%,9999999)="" S $P(^(9999999),U,9)=X
 ;
OLDKILL ;;N % S %=$P(^DIC(3,DA,0),U,16) I %]"",$D(^DIC(6,%,9999999)) S $P(^(9999999),U,9)=""
 ;

AVAP11
AVAP11 ;IHS/ASDST/GTH - DISABLE AD XREF ON FILE 4 ; [ 05/08/1999  9:20 AM ]
 ;;93.2;VA SUPPORT FILES;**11**;JUL 01, 1993
 ;
 I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." D SORRY Q
 ;
 I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." D SORRY Q
 ;
 D HOME^%ZIS,DT^DICRW
 ;
 S X=$T(+2)
 W !,$$C^XBFUNC("--  "_$P(X,";",4)_" v "_$P(X,";",3)_" Patch "_$P(X,"*",3)_"  --")
 ;
 S X=$P(^VA(200,DUZ,0),U)
 W !!,$$C^XBFUNC("Hello, "_$P(X,",",2)_" "_$P(X,",")),!!,$$C^XBFUNC("Checking Environment for Version "_$P($T(+2),";",3)_" of "_$P($T(+2),";",4)_".")
 ;
 S X="AVA",DIC="^DIC(9.4,",DIC(0)="",D="C"
 D IX^DIC
 I Y<0 D  Q
 . W !!,$$C^XBFUNC("You Have More Than One Entry In The")
 . W !,$$C^XBFUNC("PACKAGE File with an ""AVA"" prefix.")
 . W !,$$C^XBFUNC("One entry needs to be deleted.")
 . W !,$$C^XBFUNC("Please FIX IT! Before Proceeding."),!
 . D SORRY
 .Q
 ;
 S DA=+Y
 W !!,$$C^XBFUNC("AVA version '"_$G(^DIC(9.4,DA,"VERSION"))_"' currently installed")
 ;
 S X=$G(^DD("VERSION"))
 W !!,$$C^XBFUNC("Need at least FileMan 21.....FileMan "_X_" Present")
 I X<21 D SORRY Q
 ;
 S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","XU",0)),"VERSION"))
 W !!,$$C^XBFUNC("Need at least Kernel 8.....Kernel "_X_" Present")
 I X<8 D SORRY Q
 ;
 W !!,$$C^XBFUNC("ENVIRONMENT OK.")
 ;
 I '$$DIR^XBDIR("E","","","","","",1) Q
 ;
 D HELP("INTRO")
 ;
 G EOJ:'$$DIR^XBDIR("YO","Run patch 11","N")
 ;
 D WAIT^DICD
 W !,"Disabling dd..."
 ;
UPDATEDD ;EP - From A9AVA11, for RPI, non-interactive update.
 NEW AVAWRITE,DA
 S AVAWRITE='$D(ZTQUEUED)
 F %=1:1 Q:'$D(^DD(4,.01,1,%))  I $P(^(%,0),"^",2)="AD" S DA=% Q
 I '$D(DA) W:AVAWRITE !,"X-REF 'AD' not found in File 4, Field .01.",!,"That's OK!!" G EOJ
 ;
 W:AVAWRITE !,"Disabling SET of x-ref 'AD'..."
 I $E(^DD(4,.01,1,DA,1),1,4)'="Q  ;" S ^(1)="Q  ;"_^(1)
 W:AVAWRITE "Done disabling SET."
 ;
 W:AVAWRITE !,"Disabling KILL of x-ref 'AD'..."
 I $E(^DD(4,.01,1,DA,2),1,4)'="Q  ;" S ^(2)="Q  ;"_^(2)
 W:AVAWRITE "Done disabling KILL."
 ;
 S ^DD(4,.01,"DT")=$$DT^XLFDT
 KILL DA ;
 W:AVAWRITE !,"dd update complete."
 W:AVAWRITE !!,"Patch 11 to AVA 93.2 is complete.",!
 ;
 D MAIL^XBMAIL("XUMGR-XUPROGMODE","INTRO^AVAP11")
 ;
EOJ ;     
 KILL DIC,DIR,DIE,DA,DR,X,Y
 Q
 ;
INTRO ;
 ;;This is Patch 11 to AVA 93.2.
 ;;  
 ;;The 'AD' x-ref on file 4, field .01, will be disabled.  The 'AD'
 ;;x-ref was added by the VA to keep the LOCATION file in sync with
 ;;file 4 (INSTITUTION) when additions were made to file 4 by the VA's
 ;;PCE software.  This is unneeded by IHS since all additions of
 ;;locations are made into the LOCATION file, which is DINUM'd to
 ;;file 4.  Unfortunately, the 'AD' x-ref on file 4 causes an
 ;;<UNDEF> to occur when IHS attempts to add locations into the
 ;;LOCATION file.
 ;; 
 ;;This patch disables the 'AD' x-ref on file 4, field .01.
 ;;  
 ;;###
 ;
HELP(L) ;EP - Display text at label L.
 W !
 F %=1:1 W !?4,$P($T(@L+%),";",3) Q:$P($T(@L+%+1),";",3)="###"
 Q
 ;
SORRY ;
 W *7,!,$$C^XBFUNC("Sorry....")
 D EOJ
 Q
 ;

AVASLXR
AVASLXR ;IHS/DSD/CRG - STATE LICENSE FIELD X-REF ROUTINE [ 07/03/97  1:14 PM ]
 ;;93.2;VA SUPPORT FILES;**9**;JUL 01, 1993
SET ;EP - SET LOGIC
 S AVA200=$G(^DIC(16,DA(1),"A3")) Q:'AVA200
 S:'$D(^VA(200,AVA200,"PS1",0)) ^(0)="^200.541P^^"
 S ^VA(200,AVA200,"PS1",DA,0)=^DIC(6,DA(1),999999921,DA,0)
 S ^VA(200,AVA200,"PS1","B",DA,DA)=""
 D ZSET
 K AVA200
 Q
KILL ;EP - KILL LOGIC
 S AVA200=$G(^DIC(16,DA(1),"A3")) Q:'AVA200
 Q:'$D(^VA(200,AVA200,"PS1"))
 K ^VA(200,AVA200,"PS1",DA,0)
 K ^VA(200,AVA200,"PS1","B",DA,DA)
 D ZSET
 K AVA200
 Q
ZSET ;RESET ZERO NODE
 N I,J S I=0,J="" F  S I=$O(^VA(200,AVA200,"PS1",I)) Q:'I  D
 .S J=J+1
 S $P(^VA(200,AVA200,"PS1",0),"^",4)=J,$P(^(0),"^",3)=DA
 Q
INSTALL ;EP - INSTALL PATCH
 D DINUM
 D PRTR I $G(AVAQUIT) W !!,"Update aborted.",!! Q
 D IXALL
 K AVAQUIT,AVAEQ,AVAPAGE,AVACOUNT,AVADASH
 D ^%ZISC
 Q
DINUM ;DINUM FILE 200 ENTRIES
 S DA(1)=0 F  S DA(1)=$O(^VA(200,DA(1))) Q:'DA(1)  D
 .Q:'$D(^VA(200,DA(1),"PS1"))
 .D ONE
 K AVASTATE
 Q
ONE ;CONVERT ONE FILE 200 ENTRY
 M AVATMP=^VA(200,DA(1),"PS1")
 K ^VA(200,DA(1),"PS1")
 S ^VA(200,DA(1),"PS1",0)="^200.541P^^"
 S DA=0 F  S DA=$O(AVATMP(DA)) Q:'DA  D
 .S AVASTATE=$P(AVATMP(DA,0),"^",1)
 .S ^VA(200,DA(1),"PS1",AVASTATE,0)=AVATMP(DA,0)
 .S ^VA(200,DA(1),"PS1","B",AVASTATE,AVASTATE)=""
 .S $P(^VA(200,DA(1),"PS1",0),"^",3)=AVASTATE
 .S $P(^VA(200,DA(1),"PS1",0),"^",4)=$P(^(0),"^",4)+1
 K AVATMP
 Q
PRTR ;SELECT PRINTER FOR REPORT
 K AVAQUIT
 S %ZIS="",%ZIS("A")="Select device for update report: "
 D ^%ZIS I POP D
 .S DIR(0)="Y",DIR("A")="Device Not Selected. Continue",DIR("B")="NO"
 .D ^DIR K DIR
 .I Y'=1 S AVAQUIT=1
 Q
IXALL ;X-REF ALL ENTRIES, FILE 6   
 U IO
 S $P(AVAEQ,"=",80)=""
 S $P(AVADASH,"-",80)=""
 S AVAPAGE=0,AVACOUNT=0 D HDR
 S DA(1)=0 F  S DA(1)=$O(^DIC(6,DA(1))) Q:'DA(1)  D
 .S DA=0 F  S DA=$O(^DIC(6,DA(1),999999921,DA)) Q:'DA  D
 ..D SET
 ..S AVACOUNT=AVACOUNT+1
 ..W !,$P(^DIC(16,DA(1),0),"^",1)
 ..W ?30,$P(^DIC(5,DA,0),"^",1)
 ..W ?50,$P(^DIC(6,DA(1),999999921,DA,0),"^",2)
 ..D:$Y+6>IOSL HDR
 W !!,AVACOUNT," Records Processed."
 W !!!,"E N D  O F  R E P O R T",@IOF
 Q
HDR ;PRINT HEADER
 I '$D(DT) S DT=($$HTFM^XLFDT($H)\1)
 U IO
 S AVAPAGE=AVAPAGE+1
 W @IOF
 W !,?25,"STATE LICENSE NUMBER CONVERSION",?65,$$FMTE^XLFDT(DT,"D")
 W !,?15,"from file DIC(6 PROVIDER File to VA(200 NEW PERSON File"
 W !,AVADASH
 W !,"PROVIDER",?30,"STATE",?50,"LICENSE #",?70,"PAGE ",AVAPAGE
 W !,AVAEQ,!
 Q