APCD20P8 ; IHS/CMI/TUCSON - DATA ENTRY PATCH 8 [ 03/11/05 9:09 AM ]
;;2.0;IHS RPMS/PCC Data Entry;**8**;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*15") D SORRY(2)
;
Q
;
PRE ;EP
F DA=1:1:200 S DIK="^APCDERR(" D ^DIK
K DA,DIK
I '$O(^DIC(19,"B","APCD ORPHANED VISIT MENU",0)) D
.D RENAME^XPDMENU("APCD ORPHANED LAB MENU","APCD ORPHANED VISIT MENU")
Q
POST ;
S X=$$DELETE^XPDMENU("APCD LTM MENU","APCD EDUCATION TOPICS ADD/EDIT")
S X=$$DELETE^XPDMENU("APCDSUPER","APCD NEW ALLERGY LIST")
S X=$$DELETE^XPDMENU("APCDSUPER","APCD PL ALLERGY LIST")
S X=$$DELETE^XPDMENU("APCDSUPER","APCD UPDATE PCC MASTER CONTROL")
S X=$$ADD^XPDMENU("APCDMENU","APCD VISIT DISPLAY - LAB","DVB")
I 'X W "Attempt to add visit display visit option failed." H 3
S X=$$ADD^XPDMENU("APCD MENU ENTER DATA","APCDCAF EHR CODING AUDIT MENU","EHRC")
I 'X W "Attempt to add visit auditing menu option failed." H 3
S X=$$ADD^XPDMENU("APCDSUPER","APCD ALLERGY REPORTS","PLAL")
I 'X W "Attempt to add patient allergy list option failed." H 3
;S X=$$ADD^XPDMENU("APCDSUPER","APCD UPDATE PCC MASTER CONTROL","UAPL")
;I 'X W "Attempt to add update pcc master control option failed." H 3
S X=$$ADD^XPDMENU("APCD ORPHANED VISIT MENU","APCD COMP ORPHAN IMM VISITS","IM")
I 'X W "Attempt to add Orphaned Immunization visit option failed." H 3
S X=$$ADD^XPDMENU("APCD ORPHANED VISIT MENU","APCD COMP ORPHAN BLOOD BANK","BB")
I 'X W "Attempt to add Orphaned Blood Bank visit option failed." H 3
S X=$$ADD^XPDMENU("APCD ORPHANED VISIT MENU","APCD COMPLETE MICRO VISITS","MIC")
I 'X W "Attempt to add Orphaned Microbiology visit option failed." H 3
S X=$$ADD^XPDMENU("APCD LTM MENU","APCD TABLE CLINIC LIST","CL")
I 'X W "Attempt to add clinic list visit option failed." H 3
S X=$$ADD^XPDMENU("APCDMENU","APCD PRINT PCC VISIT","PDV")
I 'X W "Attempt to add Print PCC form option failed." H 3
S X=$$ADD^XPDMENU("APCD MENU UTILITIES","APCDVMDD","MR2")
I 'X W "Attempt to add Merge 2 visits/2 days option failed." H 3
S X=$$ADD^XPDMENU("APCD MENU UTILITIES","APCD MOVE V FILE DIFF DATES","MV2D")
I 'X W "Attempt to add Move data items 2 visits/2 days option failed." H 3
S X=$$ADD^XPDMENU("APCD MENU UTILITIES","APCD REPRINT GROUP FORMS","RGF")
I 'X W "Attempt to add re-print group forms option failed." H 3
S X=$$ADD^XPDMENU("APCDSUPER","APCD UPDATE PCC MASTER","UPMC")
I 'X W "Attempt to add update pcc master control option failed." H 3
S X=$$ADD^XPDMENU("APCD MENU ENTER DATA","APCD FORMS COUNT DUZ","MFC",98)
I 'X W "Attempt to add update forms count duz option failed." H 3
S X=$$ADD^XPDMENU("APCD MENU ENTER DATA","APCD SUICIDE FORM MENU","SF",99)
I 'X W "Attempt to add suicide update menu option failed." H 3
;FIX N:NORMAL TO A
S X=0 F S X=$O(^AUPNVDXP(X)) Q:X'=+X I $P(^AUPNVDXP(X,0),U,4)="N:NORMAL" S $P(^AUPNVDXP(X,0),U,4)="A"
S APCDX=0 F S APCDX=$O(^APCDTKW("B","CTC",APCDX)) Q:APCDX'=+APCDX S DA=APCDX,DIK="^APCDTKW(" D ^DIK K DIK,DA
S APCDX=0 F S APCDX=$O(^APCDTKW("B","CTE",APCDX)) Q:APCDX'=+APCDX S DA=APCDX,DIK="^APCDTKW(" D ^DIK K DIK,DA
D AST
D CC
D COC
D PCF
D PF
D HAST
D O2
D PA
D CEF
D IIM
D HRX
D ALG
D HHF
D UAS
D ADA
D HADA
D WC
D IF
D PIF
D REG
D CTC
D CTE
D SF
D ^APCDBUL8
Q
ALG ;
D ^XBFMK
Q:$D(^APCDTKW("B","ALG"))
S X="ALG",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".02///S;.03///9000001;.04///[APCD ALG];.06///Allergy Tracking Entry;.07///0;.08///0"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding ALG mnemonic failed." H 4
K DIC,DD,D0,DO
Q
SF ;
D ^XBFMK
Q:$D(^APCDTKW("B","SF"))
S X="SF",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".02///S;.03///9000001;.04///[APCD SF];.06///Suicide Form Entry;.07///0;.08///0"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding SF mnemonic failed." H 4
K DIC,DD,D0,DO
Q
ADA ;
D ^XBFMK
Q:$D(^APCDTKW("B","ADA"))
S X="ADA",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD ADA];.06///ADA Code Entry;.07///0;.08///1;.12///ADA codes;.14///9000010.05;.09///9000010.05"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding ADA mnemonic failed." H 4
K DIC,DD,D0,DO
Q
IF ;
D ^XBFMK
Q:$D(^APCDTKW("B","IF"))
S X="IF",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD IF];.06///Infant Feeding Choices;.07///0;.08///1;.14///9000010.44;.09///9000010.44"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding IF mnemonic failed." H 4
K DIC,DD,D0,DO
Q
CTC ;
D ^XBFMK
Q:$D(^APCDTKW("B","CTC"))
S X="CTC",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD CTC];.06///CAN TRAN CODE ENTRY;.07///0;.08///1;.14///9000010.33;.09///9000010.33"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding CTC mnemonic failed." H 4
K DIC,DD,D0,DO
Q
CTE ;
D ^XBFMK
Q:$D(^APCDTKW("B","CTE"))
S X="CTE",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD CTE];.06///CAN TRAN CODE ENTRY TE;.07///0;.08///1;.14///9000010.33;.09///9000010.33"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding CTE mnemonic failed." H 4
K DIC,DD,D0,DO
Q
UAS ;
D ^XBFMK
Q:$D(^APCDTKW("B","UAS"))
S X="UAS",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000001;.04///[APCD UAS];.06///Unable to Screen;.07///0;.08///0;.09///9000022"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding UAS mnemonic failed." H 4
K DIC,DD,D0,DO
Q
HHF ;
D ^XBFMK
Q:$D(^APCDTKW("B","HHF"))
S X="HHF",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000001;.04///[APCD HHF];.06///Historical Health Factor;.07///0;.08///0"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding HHF mnemonic failed." H 4
K DIC,DD,D0,DO
Q
HADA ;
D ^XBFMK
Q:$D(^APCDTKW("B","HADA"))
S X="HADA",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000001;.04///[APCD HADA];.06///Historical ADA Code entry;.07///0;.08///0;.09///9000010.05;.12///Historical ADA codes;.14///9000010.05;.15///66;.16///66"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding HADA mnemonic failed." H 4
K DIC,DD,D0,DO
Q
HRX ;
S DA=$O(^APCDTKW("B","HRX",0))
Q:'DA
S DR=".15///99;.16///99",DIE="^APCDTKW(" D ^DIE,^XBFMK
Q
AST ;
D ^XBFMK
Q:$D(^APCDTKW("B","AST"))
S X="AST",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD AST];.06///Asthma;.07///0;.08///1;.09///9000010.41"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding AST mnemonic failed." H 4
K DIC,DD,D0,DO
Q
;
CC ;
D ^XBFMK
Q:$D(^APCDTKW("B","CC"))
S X="CC",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".02///S;.03///9000010;.04///[APCD CC];.06///Chief Complaint;.07///0;.08///1"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding CC mnemonic failed." H 4
K DIC,DD,D0,DO
Q
COC ;
D ^XBFMK
Q:$D(^APCDTKW("B","COC"))
S X="COC",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".02///S;.03///9000010;.04///[APCD COC];.06///Coded Chief Complaint;.07///0;.08///1"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding CC mnemonic failed." H 4
K DIC,DD,D0,DO
Q
PIF ;
D ^XBFMK
Q:$D(^APCDTKW("B","PIF"))
S X="PIF",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".02///S;.03///9000001;.04///[APCD PIF];.06///Infant Feeding Patient Data;.07///0;.08///0;.14///9000024"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding PIF mnemonic failed." H 4
K DIC,DD,D0,DO
Q
REG ;
D ^XBFMK
Q:$D(^APCDTKW("B","REG"))
S X="REG",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".02///S;.03///9000001;.04///[APCD REG];.06///Add Patient to a Register;.07///1;.08///0"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding REG mnemonic failed." H 4
K DIC,DD,D0,DO
Q
PCF ;
D ^XBFMK
Q:$D(^APCDTKW("B","PCF"))
S X="PCF",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".02///S;.03///9000010;.04///[APCD PCF];.06///Infant Feeding Patient Data;.07///0;.08///1"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding PCF mnemonic failed." H 4
K DIC,DD,D0,DO
Q
PF ;
D ^XBFMK
Q:$D(^APCDTKW("B","PF"))
S X="PF",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""PF"";.06///Peak Flow;.07///0;.08///1;.09///9000010.01"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding PF mnemonic failed." H 4
K DIC,DD,D0,DO
Q
HAST ;
D ^XBFMK
Q:$D(^APCDTKW("B","HAST"))
S X="HAST",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000001;.04///[APCD HAST];.06///Historical Asthma Data;.07///0;.08///0"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding HAST mnemonic failed." H 4
K DIC,DD,D0,DO
Q
IIM ;
D ^XBFMK
Q:$D(^APCDTKW("B","IIM"))
S X="IIM",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000001;.04///[APCD IIM];.06///In-Hospital Immunization Entry;.07///0;.08///0"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding IIM mnemonic failed." H 4
K DIC,DD,D0,DO
Q
PA ;
D ^XBFMK
Q:$D(^APCDTKW("B","PA"))
S X="PA",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""PA"";.06///Pain;.07///0;.08///1;.09///9000010.01"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding PA mnemonic failed." H 4
K DIC,DD,D0,DO
Q
CEF ;
D ^XBFMK
Q:$D(^APCDTKW("B","CEF"))
S X="CEF",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""CEF"";.06///Cardiac Ejection Fraction;.07///0;.08///1;.09///9000010.01"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding CEF mnemonic failed." H 4
K DIC,DD,D0,DO
Q
WC ;
D ^XBFMK
Q:$D(^APCDTKW("B","WC"))
S X="WC",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""WC"";.06///Waist Measurement;.07///0;.08///1;.09///9000010.01"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding WC mnemonic failed." H 4
K DIC,DD,D0,DO
Q
O2 ;
D ^XBFMK
Q:$D(^APCDTKW("B","O2"))
S X="O2",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""O2"";.06///O2 Saturation;.07///0;.08///1;.09///9000010.01"
K DD,D0,DO
D FILE^DICN
I Y=-1 W !!,"Adding O2 mnemonic failed." H 4
K DIC,DD,D0,DO
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
APCD20P8 ; IHS/CMI/TUCSON - DATA ENTRY PATCH 8 [ 03/11/05 9:09 AM ]
+1 ;;2.0;IHS RPMS/PCC Data Entry;**8**;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*15")
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 IF '$ORDER(^DIC(19,"B","APCD ORPHANED VISIT MENU",0))
Begin DoDot:1
+4 DO RENAME^XPDMENU("APCD ORPHANED LAB MENU","APCD ORPHANED VISIT MENU")
End DoDot:1
+5 QUIT
POST ;
+1 SET X=$$DELETE^XPDMENU("APCD LTM MENU","APCD EDUCATION TOPICS ADD/EDIT")
+2 SET X=$$DELETE^XPDMENU("APCDSUPER","APCD NEW ALLERGY LIST")
+3 SET X=$$DELETE^XPDMENU("APCDSUPER","APCD PL ALLERGY LIST")
+4 SET X=$$DELETE^XPDMENU("APCDSUPER","APCD UPDATE PCC MASTER CONTROL")
+5 SET X=$$ADD^XPDMENU("APCDMENU","APCD VISIT DISPLAY - LAB","DVB")
+6 IF 'X
WRITE "Attempt to add visit display visit option failed."
HANG 3
+7 SET X=$$ADD^XPDMENU("APCD MENU ENTER DATA","APCDCAF EHR CODING AUDIT MENU","EHRC")
+8 IF 'X
WRITE "Attempt to add visit auditing menu option failed."
HANG 3
+9 SET X=$$ADD^XPDMENU("APCDSUPER","APCD ALLERGY REPORTS","PLAL")
+10 IF 'X
WRITE "Attempt to add patient allergy list option failed."
HANG 3
+11 ;S X=$$ADD^XPDMENU("APCDSUPER","APCD UPDATE PCC MASTER CONTROL","UAPL")
+12 ;I 'X W "Attempt to add update pcc master control option failed." H 3
+13 SET X=$$ADD^XPDMENU("APCD ORPHANED VISIT MENU","APCD COMP ORPHAN IMM VISITS","IM")
+14 IF 'X
WRITE "Attempt to add Orphaned Immunization visit option failed."
HANG 3
+15 SET X=$$ADD^XPDMENU("APCD ORPHANED VISIT MENU","APCD COMP ORPHAN BLOOD BANK","BB")
+16 IF 'X
WRITE "Attempt to add Orphaned Blood Bank visit option failed."
HANG 3
+17 SET X=$$ADD^XPDMENU("APCD ORPHANED VISIT MENU","APCD COMPLETE MICRO VISITS","MIC")
+18 IF 'X
WRITE "Attempt to add Orphaned Microbiology visit option failed."
HANG 3
+19 SET X=$$ADD^XPDMENU("APCD LTM MENU","APCD TABLE CLINIC LIST","CL")
+20 IF 'X
WRITE "Attempt to add clinic list visit option failed."
HANG 3
+21 SET X=$$ADD^XPDMENU("APCDMENU","APCD PRINT PCC VISIT","PDV")
+22 IF 'X
WRITE "Attempt to add Print PCC form option failed."
HANG 3
+23 SET X=$$ADD^XPDMENU("APCD MENU UTILITIES","APCDVMDD","MR2")
+24 IF 'X
WRITE "Attempt to add Merge 2 visits/2 days option failed."
HANG 3
+25 SET X=$$ADD^XPDMENU("APCD MENU UTILITIES","APCD MOVE V FILE DIFF DATES","MV2D")
+26 IF 'X
WRITE "Attempt to add Move data items 2 visits/2 days option failed."
HANG 3
+27 SET X=$$ADD^XPDMENU("APCD MENU UTILITIES","APCD REPRINT GROUP FORMS","RGF")
+28 IF 'X
WRITE "Attempt to add re-print group forms option failed."
HANG 3
+29 SET X=$$ADD^XPDMENU("APCDSUPER","APCD UPDATE PCC MASTER","UPMC")
+30 IF 'X
WRITE "Attempt to add update pcc master control option failed."
HANG 3
+31 SET X=$$ADD^XPDMENU("APCD MENU ENTER DATA","APCD FORMS COUNT DUZ","MFC",98)
+32 IF 'X
WRITE "Attempt to add update forms count duz option failed."
HANG 3
+33 SET X=$$ADD^XPDMENU("APCD MENU ENTER DATA","APCD SUICIDE FORM MENU","SF",99)
+34 IF 'X
WRITE "Attempt to add suicide update menu option failed."
HANG 3
+35 ;FIX N:NORMAL TO A
+36 SET X=0
FOR
SET X=$ORDER(^AUPNVDXP(X))
IF X'=+X
QUIT
IF $PIECE(^AUPNVDXP(X,0),U,4)="N:NORMAL"
SET $PIECE(^AUPNVDXP(X,0),U,4)="A"
+37 SET APCDX=0
FOR
SET APCDX=$ORDER(^APCDTKW("B","CTC",APCDX))
IF APCDX'=+APCDX
QUIT
SET DA=APCDX
SET DIK="^APCDTKW("
DO ^DIK
KILL DIK,DA
+38 SET APCDX=0
FOR
SET APCDX=$ORDER(^APCDTKW("B","CTE",APCDX))
IF APCDX'=+APCDX
QUIT
SET DA=APCDX
SET DIK="^APCDTKW("
DO ^DIK
KILL DIK,DA
+39 DO AST
+40 DO CC
+41 DO COC
+42 DO PCF
+43 DO PF
+44 DO HAST
+45 DO O2
+46 DO PA
+47 DO CEF
+48 DO IIM
+49 DO HRX
+50 DO ALG
+51 DO HHF
+52 DO UAS
+53 DO ADA
+54 DO HADA
+55 DO WC
+56 DO IF
+57 DO PIF
+58 DO REG
+59 DO CTC
+60 DO CTE
+61 DO SF
+62 DO ^APCDBUL8
+63 QUIT
ALG ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","ALG"))
QUIT
+3 SET X="ALG"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".02///S;.03///9000001;.04///[APCD ALG];.06///Allergy Tracking Entry;.07///0;.08///0"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding ALG mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
SF ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","SF"))
QUIT
+3 SET X="SF"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".02///S;.03///9000001;.04///[APCD SF];.06///Suicide Form Entry;.07///0;.08///0"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding SF mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
ADA ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","ADA"))
QUIT
+3 SET X="ADA"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000010;.04///[APCD ADA];.06///ADA Code Entry;.07///0;.08///1;.12///ADA codes;.14///9000010.05;.09///9000010.05"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding ADA mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
IF ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","IF"))
QUIT
+3 SET X="IF"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000010;.04///[APCD IF];.06///Infant Feeding Choices;.07///0;.08///1;.14///9000010.44;.09///9000010.44"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding IF mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
CTC ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","CTC"))
QUIT
+3 SET X="CTC"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000010;.04///[APCD CTC];.06///CAN TRAN CODE ENTRY;.07///0;.08///1;.14///9000010.33;.09///9000010.33"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding CTC mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
CTE ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","CTE"))
QUIT
+3 SET X="CTE"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000010;.04///[APCD CTE];.06///CAN TRAN CODE ENTRY TE;.07///0;.08///1;.14///9000010.33;.09///9000010.33"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding CTE mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
UAS ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","UAS"))
QUIT
+3 SET X="UAS"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000001;.04///[APCD UAS];.06///Unable to Screen;.07///0;.08///0;.09///9000022"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding UAS mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
HHF ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","HHF"))
QUIT
+3 SET X="HHF"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000001;.04///[APCD HHF];.06///Historical Health Factor;.07///0;.08///0"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding HHF mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
HADA ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","HADA"))
QUIT
+3 SET X="HADA"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000001;.04///[APCD HADA];.06///Historical ADA Code entry;.07///0;.08///0;.09///9000010.05;.12///Historical ADA codes;.14///9000010.05;.15///66;.16///66"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding HADA mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
HRX ;
+1 SET DA=$ORDER(^APCDTKW("B","HRX",0))
+2 IF 'DA
QUIT
+3 SET DR=".15///99;.16///99"
SET DIE="^APCDTKW("
DO ^DIE
DO ^XBFMK
+4 QUIT
AST ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","AST"))
QUIT
+3 SET X="AST"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000010;.04///[APCD AST];.06///Asthma;.07///0;.08///1;.09///9000010.41"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding AST mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
+9 ;
CC ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","CC"))
QUIT
+3 SET X="CC"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".02///S;.03///9000010;.04///[APCD CC];.06///Chief Complaint;.07///0;.08///1"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding CC mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
COC ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","COC"))
QUIT
+3 SET X="COC"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".02///S;.03///9000010;.04///[APCD COC];.06///Coded Chief Complaint;.07///0;.08///1"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding CC mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
PIF ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","PIF"))
QUIT
+3 SET X="PIF"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".02///S;.03///9000001;.04///[APCD PIF];.06///Infant Feeding Patient Data;.07///0;.08///0;.14///9000024"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding PIF mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
REG ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","REG"))
QUIT
+3 SET X="REG"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".02///S;.03///9000001;.04///[APCD REG];.06///Add Patient to a Register;.07///1;.08///0"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding REG mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
PCF ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","PCF"))
QUIT
+3 SET X="PCF"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".02///S;.03///9000010;.04///[APCD PCF];.06///Infant Feeding Patient Data;.07///0;.08///1"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding PCF mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
PF ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","PF"))
QUIT
+3 SET X="PF"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""PF"";.06///Peak Flow;.07///0;.08///1;.09///9000010.01"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding PF mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
HAST ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","HAST"))
QUIT
+3 SET X="HAST"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000001;.04///[APCD HAST];.06///Historical Asthma Data;.07///0;.08///0"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding HAST mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
IIM ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","IIM"))
QUIT
+3 SET X="IIM"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000001;.04///[APCD IIM];.06///In-Hospital Immunization Entry;.07///0;.08///0"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding IIM mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
PA ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","PA"))
QUIT
+3 SET X="PA"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""PA"";.06///Pain;.07///0;.08///1;.09///9000010.01"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding PA mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
CEF ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","CEF"))
QUIT
+3 SET X="CEF"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""CEF"";.06///Cardiac Ejection Fraction;.07///0;.08///1;.09///9000010.01"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding CEF mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
WC ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","WC"))
QUIT
+3 SET X="WC"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""WC"";.06///Waist Measurement;.07///0;.08///1;.09///9000010.01"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding WC mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
O2 ;
+1 DO ^XBFMK
+2 IF $DATA(^APCDTKW("B","O2"))
QUIT
+3 SET X="O2"
SET DIC(0)="L"
SET DIC="^APCDTKW("
SET DIC("DR")=".03///9000010;.04///[APCD MEASUREMENT];.05///""O2"";.06///O2 Saturation;.07///0;.08///1;.09///9000010.01"
+4 KILL DD,D0,DO
+5 DO FILE^DICN
+6 IF Y=-1
WRITE !!,"Adding O2 mnemonic failed."
HANG 4
+7 KILL DIC,DD,D0,DO
+8 QUIT
+9 ;
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
