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
