APCD2010 ; IHS/CMI/TUCSON - DATA ENTRY PATCH 10 [ 03/11/05 9:09 AM ]
;;2.0;IHS RPMS/PCC Data Entry;**10**;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*18") D SORRY(2)
I '$$INSTALLD("APCD*2.0*9") D SORRY(2)
I '$$INSTALLD("AICD*3.51*7") D SORRY(2)
I '$D(^DIC(9.4,"C","LEX")) D MES^XPDUTL($$CJ^XLFSTR("Lexicon is *NOT* installed.",IOM)) D SORRY(2)
;
Q
;
PRE ;EP
F DA=1:1:200 S DIK="^APCDERR(" D ^DIK
K DA,DIK
F DA=1:1:200 S DIK="^APCDINPT(" 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")=""
EDUC ;
;EDUCATION TOPICS CHANGES PER CHRIS SADDLER
S DA=$O(^APCDEDCV("C","L",0)) I DA S DIE="^APCDEDCV(",DR=".01///LITERATURE" D ^DIE
K DA,DIE,DR
S DA=$O(^APCDEDCV("C","TE",0)) I DA S DIE="^APCDEDCV(",DR=".01///TESTS" D ^DIE
K DA,DR,DIE
Q
POST ;
;
WCE ;
D ^XBFMK
I '$D(^APCDTKW("B","CRFT")) D
.S X="CRFT",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""CRFT"";.06///CRAFFT;.07///0;.08///1;.09///9000010.01"
.K DD,D0,DO
.D FILE^DICN
.I Y=-1 W !!,"Adding CRFT mnemonic failed." H 4
I '$D(^APCDTKW("B","AUDT")) D
.S X="AUDT",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""AUDT"";.06///AUDIT;.07///0;.08///1;.09///9000010.01"
.K DD,D0,DO
.D FILE^DICN
.I Y=-1 W !!,"Adding AUDT mnemonic failed." H 4
I '$D(^APCDTKW("B","PHQ2")) D
.S X="PHQ2",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""PHQ2"";.06///PHQ2;.07///0;.08///1;.09///9000010.01"
.K DD,D0,DO
.D FILE^DICN
.I Y=-1 W !!,"Adding PHQ2 mnemonic failed." H 4
I '$D(^APCDTKW("B","PHQ9")) D
.S X="PHQ9",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""PHQ9"";.06///PHQ9;.07///0;.08///1;.09///9000010.01"
.K DD,D0,DO
.D FILE^DICN
.I Y=-1 W !!,"Adding PHQ2 mnemonic failed." H 4
I '$D(^APCDTKW("B","HCPT")) D
.S X="HCPT",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000001;.04///[APCD HCPT];.06///Historical CPT;.07///0;.08///0;.09///9000010.18;.15///71;.16///71"
.K DD,D0,DO
.D FILE^DICN
.I Y=-1 W !!,"Adding HCPT mnemonic failed." H 4
K DIC,DD,D0,DO
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"
;
D ^APCDBUL0
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
APCD2010 ; IHS/CMI/TUCSON - DATA ENTRY PATCH 10 [ 03/11/05 9:09 AM ]
+1 ;;2.0;IHS RPMS/PCC Data Entry;**10**;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*18")
DO SORRY(2)
+8 IF '$$INSTALLD("APCD*2.0*9")
DO SORRY(2)
+9 IF '$$INSTALLD("AICD*3.51*7")
DO SORRY(2)
+10 IF '$DATA(^DIC(9.4,"C","LEX"))
DO MES^XPDUTL($$CJ^XLFSTR("Lexicon is *NOT* installed.",IOM))
DO SORRY(2)
+11 ;
+12 QUIT
+13 ;
PRE ;EP
+1 FOR DA=1:1:200
SET DIK="^APCDERR("
DO ^DIK
+2 KILL DA,DIK
+3 FOR DA=1:1:200
SET DIK="^APCDINPT("
DO ^DIK
+4 KILL DA,DIK
+5 SET X=$ORDER(^DIE("B","APCD WC (ADD)",0))
+6 IF X
SET ^DIE(X,"ROU")=""
+7 SET X=$ORDER(^DIE("B","APCD WC (MOD)",0))
+8 IF X
SET ^DIE(X,"ROU")=""
EDUC ;
+1 ;EDUCATION TOPICS CHANGES PER CHRIS SADDLER
+2 SET DA=$ORDER(^APCDEDCV("C","L",0))
IF DA
SET DIE="^APCDEDCV("
SET DR=".01///LITERATURE"
DO ^DIE
+3 KILL DA,DIE,DR
+4 SET DA=$ORDER(^APCDEDCV("C","TE",0))
IF DA
SET DIE="^APCDEDCV("
SET DR=".01///TESTS"
DO ^DIE
+5 KILL DA,DR,DIE
+6 QUIT
POST ;
+1 ;
WCE ;
+1 DO ^XBFMK
+2 IF '$DATA(^APCDTKW("B","CRFT"))
Begin DoDot:1
+3 SET X="CRFT"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""CRFT"";.06///CRAFFT;.07///0;.08///1;.09///9000010.01"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding CRFT mnemonic failed."
HANG 4
End DoDot:1
+7 IF '$DATA(^APCDTKW("B","AUDT"))
Begin DoDot:1
+8 SET X="AUDT"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""AUDT"";.06///AUDIT;.07///0;.08///1;.09///9000010.01"
+9 KILL DD,D0,DO
+10 DO FILE^DICN
+11 IF Y=-1
WRITE !!,"Adding AUDT mnemonic failed."
HANG 4
End DoDot:1
+12 IF '$DATA(^APCDTKW("B","PHQ2"))
Begin DoDot:1
+13 SET X="PHQ2"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""PHQ2"";.06///PHQ2;.07///0;.08///1;.09///9000010.01"
+14 KILL DD,D0,DO
+15 DO FILE^DICN
+16 IF Y=-1
WRITE !!,"Adding PHQ2 mnemonic failed."
HANG 4
End DoDot:1
+17 IF '$DATA(^APCDTKW("B","PHQ9"))
Begin DoDot:1
+18 SET X="PHQ9"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""PHQ9"";.06///PHQ9;.07///0;.08///1;.09///9000010.01"
+19 KILL DD,D0,DO
+20 DO FILE^DICN
+21 IF Y=-1
WRITE !!,"Adding PHQ2 mnemonic failed."
HANG 4
End DoDot:1
+22 IF '$DATA(^APCDTKW("B","HCPT"))
Begin DoDot:1
+23 SET X="HCPT"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000001;.04///[APCD HCPT];.06///Historical CPT;.07///0;.08///0;.09///9000010.18;.15///71;.16///71"
+24 KILL DD,D0,DO
+25 DO FILE^DICN
+26 IF Y=-1
WRITE !!,"Adding HCPT mnemonic failed."
HANG 4
End DoDot:1
+27 KILL DIC,DD,D0,DO
+28 SET X=$ORDER(^DIE("B","APCD WC (ADD)",0))
+29 IF X
SET ^DIE(X,"ROU")="^APCDTWC"
+30 SET X=$ORDER(^DIE("B","APCD WC (MOD)",0))
+31 IF X
SET ^DIE(X,"ROU")="^APCDTWC"
+32 ;
+33 DO ^APCDBUL0
+34 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
