Routine: APCD20P8

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)

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")

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

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

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

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

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

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

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

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

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

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

HRX ;

 S DA=$O(^APCDTKW("B","HRX",0))

 Q:'DA

 S DR=".15///99;.16///99",DIE="^APCDTKW(" D ^DIE,^XBFMK

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

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

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

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

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

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

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

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

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

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

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

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

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

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))

SORRY(X) ;

 KILL DIFQ

 I X=3 S XPDQUIT=2 Q

 S XPDQUIT=X

 W *7,!,$$CJ^XLFSTR("Sorry....FIX IT!",IOM)

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

APCD20P8.m