- APCD20P9 ; IHS/CMI/TUCSON - DATA ENTRY PATCH 8 [ 03/11/05 9:09 AM ]
- ;;2.0;IHS RPMS/PCC Data Entry;**9**;MAR 09, 1999
- ;
- ; The following line prevents the "Disable Options..." and "Move
- ; Routines..." questions from being asked during the install.
- I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
- F X="XPO1","XPZ1","XPZ2","XPI1" S XPDDIQ(X)=0
- I '$$INSTALLD("AUPN*99.1*17") D SORRY(2)
- ;
- Q
- ;
- PRE ;EP
- F DA=1:1:200 S DIK="^APCDERR(" D ^DIK
- K DA,DIK
- S X=$O(^DIE("B","APCD WC (ADD)",0))
- I X S ^DIE(X,"ROU")=""
- S X=$O(^DIE("B","APCD WC (MOD)",0))
- I X S ^DIE(X,"ROU")=""
- Q
- POST ;
- S X=$$ADD^XPDMENU("APCDSUPER","APCD DELETE DUPE PRIM PROV","DDPR")
- I 'X W "Attempt to add DELETE DUPE PRIM PROV option failed." H 3
- S X=$$ADD^XPDMENU("APCDSUPER","APCD OTHER REPORTS","OTH")
- I 'X W "Attempt to add OTHER REPORTS option failed." H 3
- S X=$$ADD^XPDMENU("APCD MENU UTILITIES","APCD GROWTH CHARTS","GC")
- I 'X W "Attempt to add GROWTH CHARTS OPTION option failed." H 3
- WCE ;
- D ^XBFMK
- S X=$O(^DIE("B","APCD WC (ADD)",0))
- I X S ^DIE(X,"ROU")="^APCDTWC"
- S X=$O(^DIE("B","APCD WC (MOD)",0))
- I X S ^DIE(X,"ROU")="^APCDTWC"
- I '$D(^APCDTKW("B","WCE")) D
- .S X="WCE",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD WC];.06///Well Child Exam;.07///0;.08///1;.14///9000010.46;.09///9000010.46"
- .K DD,D0,DO
- .D FILE^DICN
- .I Y=-1 W !!,"Adding WCE mnemonic failed." H 4
- I '$D(^APCDTKW("B","AKBP")) D
- .S X="AKBP",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""AKBP"";.06///Ankle BP;.07///0;.08///1;.09///9000010.01"
- .K DD,D0,DO
- .D FILE^DICN
- .I Y=-1 W !!,"Adding AKBP mnemonic failed." H 4
- I '$D(^APCDTKW("B","RHC")) D
- .S X="RHC",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".02///S;.03///9000010;.04///[APCD RHC];.06///Reproductive History;.07///0;.08///0;.14///9000017;.09///9000017"
- .K DD,D0,DO
- .D FILE^DICN
- .I Y=-1 W !!,"Adding RHC mnemonic failed." H 4
- K DIC,DD,D0,DO
- D ^APCDBUL9
- ;K ^DD(9000022,.04,12),^DD(9000022,.04,12.1) ;get rid of true input tx
- Q
- INSTALLD(APCDSTAL) ;EP - Determine if patch APCDSTAL was installed, where
- ; APCDSTAL is the name of the INSTALL. E.g "AG*6.0*11".
- ;
- NEW APCDY,DIC,X,Y
- S X=$P(APCDSTAL,"*",1)
- S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
- D IX^DIC
- I Y<1 D IMES Q 0
- S DIC=DIC_+Y_",22,",X=$P(APCDSTAL,"*",2)
- D ^DIC
- I Y<1 D IMES Q 0
- S DIC=DIC_+Y_",""PAH"",",X=$P(APCDSTAL,"*",3)
- D ^DIC
- S APCDY=Y
- D IMES
- Q $S(APCDY<1:0,1:1)
- IMES ;
- D MES^XPDUTL($$CJ^XLFSTR("Patch """_APCDSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
- Q
- SORRY(X) ;
- KILL DIFQ
- I X=3 S XPDQUIT=2 Q
- S XPDQUIT=X
- W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
- Q
- APCD20P9 ; IHS/CMI/TUCSON - DATA ENTRY PATCH 8 [ 03/11/05 9:09 AM ]
- +1 ;;2.0;IHS RPMS/PCC Data Entry;**9**;MAR 09, 1999
- +2 ;
- +3 ; The following line prevents the "Disable Options..." and "Move
- +4 ; Routines..." questions from being asked during the install.
- +5 IF $GET(XPDENV)=1
- SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
- +6 FOR X="XPO1","XPZ1","XPZ2","XPI1"
- SET XPDDIQ(X)=0
- +7 IF '$$INSTALLD("AUPN*99.1*17")
- DO SORRY(2)
- +8 ;
- +9 QUIT
- +10 ;
- PRE ;EP
- +1 FOR DA=1:1:200
- SET DIK="^APCDERR("
- DO ^DIK
- +2 KILL DA,DIK
- +3 SET X=$ORDER(^DIE("B","APCD WC (ADD)",0))
- +4 IF X
- SET ^DIE(X,"ROU")=""
- +5 SET X=$ORDER(^DIE("B","APCD WC (MOD)",0))
- +6 IF X
- SET ^DIE(X,"ROU")=""
- +7 QUIT
- POST ;
- +1 SET X=$$ADD^XPDMENU("APCDSUPER","APCD DELETE DUPE PRIM PROV","DDPR")
- +2 IF 'X
- WRITE "Attempt to add DELETE DUPE PRIM PROV option failed."
- HANG 3
- +3 SET X=$$ADD^XPDMENU("APCDSUPER","APCD OTHER REPORTS","OTH")
- +4 IF 'X
- WRITE "Attempt to add OTHER REPORTS option failed."
- HANG 3
- +5 SET X=$$ADD^XPDMENU("APCD MENU UTILITIES","APCD GROWTH CHARTS","GC")
- +6 IF 'X
- WRITE "Attempt to add GROWTH CHARTS OPTION option failed."
- HANG 3
- WCE ;
- +1 DO ^XBFMK
- +2 SET X=$ORDER(^DIE("B","APCD WC (ADD)",0))
- +3 IF X
- SET ^DIE(X,"ROU")="^APCDTWC"
- +4 SET X=$ORDER(^DIE("B","APCD WC (MOD)",0))
- +5 IF X
- SET ^DIE(X,"ROU")="^APCDTWC"
- +6 IF '$DATA(^APCDTKW("B","WCE"))
- Begin DoDot:1
- +7 SET X="WCE"
- SET DIC(0)="L"
- SET DIC="^APCDTKW("
- SET DIC("DR")=".03///9000010;.04///[APCD WC];.06///Well Child Exam;.07///0;.08///1;.14///9000010.46;.09///9000010.46"
- +8 KILL DD,D0,DO
- +9 DO FILE^DICN
- +10 IF Y=-1
- WRITE !!,"Adding WCE mnemonic failed."
- HANG 4
- End DoDot:1
- +11 IF '$DATA(^APCDTKW("B","AKBP"))
- Begin DoDot:1
- +12 SET X="AKBP"
- SET DIC(0)="L"
- SET DIC="^APCDTKW("
- SET DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""AKBP"";.06///Ankle BP;.07///0;.08///1;.09///9000010.01"
- +13 KILL DD,D0,DO
- +14 DO FILE^DICN
- +15 IF Y=-1
- WRITE !!,"Adding AKBP mnemonic failed."
- HANG 4
- End DoDot:1
- +16 IF '$DATA(^APCDTKW("B","RHC"))
- Begin DoDot:1
- +17 SET X="RHC"
- SET DIC(0)="L"
- SET DIC="^APCDTKW("
- SET DIC("DR")=".02///S;.03///9000010;.04///[APCD RHC];.06///Reproductive History;.07///0;.08///0;.14///9000017;.09///9000017"
- +18 KILL DD,D0,DO
- +19 DO FILE^DICN
- +20 IF Y=-1
- WRITE !!,"Adding RHC mnemonic failed."
- HANG 4
- End DoDot:1
- +21 KILL DIC,DD,D0,DO
- +22 DO ^APCDBUL9
- +23 ;K ^DD(9000022,.04,12),^DD(9000022,.04,12.1) ;get rid of true input tx
- +24 QUIT
- INSTALLD(APCDSTAL) ;EP - Determine if patch APCDSTAL was installed, where
- +1 ; APCDSTAL is the name of the INSTALL. E.g "AG*6.0*11".
- +2 ;
- +3 NEW APCDY,DIC,X,Y
- +4 SET X=$PIECE(APCDSTAL,"*",1)
- +5 SET DIC="^DIC(9.4,"
- SET DIC(0)="FM"
- SET D="C"
- +6 DO IX^DIC
- +7 IF Y<1
- DO IMES
- QUIT 0
- +8 SET DIC=DIC_+Y_",22,"
- SET X=$PIECE(APCDSTAL,"*",2)
- +9 DO ^DIC
- +10 IF Y<1
- DO IMES
- QUIT 0
- +11 SET DIC=DIC_+Y_",""PAH"","
- SET X=$PIECE(APCDSTAL,"*",3)
- +12 DO ^DIC
- +13 SET APCDY=Y
- +14 DO IMES
- +15 QUIT $SELECT(APCDY<1:0,1:1)
- IMES ;
- +1 DO MES^XPDUTL($$CJ^XLFSTR("Patch """_APCDSTAL_""" is"_$SELECT(Y<1:" *NOT*",1:"")_" installed.",IOM))
- +2 QUIT
- SORRY(X) ;
- +1 KILL DIFQ
- +2 IF X=3
- SET XPDQUIT=2
- QUIT
- +3 SET XPDQUIT=X
- +4 WRITE *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)
- +5 QUIT
