APCD20P7.m

APCD20P7 ; IHS/CMI/TUCSON - DATA ENTRY PATCH 7 [ 03/18/04  2:18 PM ]

 ;;2.0;IHS RPMS/PCC Data Entry;**7**;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

 ;

 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 ;

 NEW X

 S X=$$DELETE^XPDMENU("APCDSUPER","APCD NEW ALLERGY LIST")

 S X=$$DELETE^XPDMENU("APCDSUPER","APCD PL ALLERGY LIST")

 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("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 REPRINT GROUP FORMS","RGF")

 I 'X W "Attempt to add re-print group forms option failed." H 3

 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 ^APCDBUL7

 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

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

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

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///PCC+ Form;.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

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

 ;

APCD20P7  ; IHS/CMI/TUCSON - DATA ENTRY PATCH 7 [ 03/18/04  2:18 PM ]

 +1       ;;2.0;IHS RPMS/PCC Data Entry;**7**;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       ;

 +7        QUIT 

 +8       ;

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        NEW X

 +2        SET X=$$DELETE^XPDMENU("APCDSUPER","APCD NEW ALLERGY LIST")

 +3        SET X=$$DELETE^XPDMENU("APCDSUPER","APCD PL ALLERGY LIST")

 +4        SET X=$$ADD^XPDMENU("APCDMENU","APCD VISIT DISPLAY - LAB","DVB")

 +5        IF 'X

               WRITE "Attempt to add visit display visit option failed."

               HANG 3

 +6        SET X=$$ADD^XPDMENU("APCDSUPER","APCD ALLERGY REPORTS","PLAL")

 +7        IF 'X

               WRITE "Attempt to add patient allergy list option failed."

               HANG 3

 +8        SET X=$$ADD^XPDMENU("APCDSUPER","APCD UPDATE PCC MASTER CONTROL","UAPL")

 +9        IF 'X

               WRITE "Attempt to add update pcc master control option failed."

               HANG 3

 +10       SET X=$$ADD^XPDMENU("APCD ORPHANED VISIT MENU","APCD COMP ORPHAN IMM VISITS","IM")

 +11       IF 'X

               WRITE "Attempt to add Orphaned Immunization visit option failed."

               HANG 3

 +12       SET X=$$ADD^XPDMENU("APCD ORPHANED VISIT MENU","APCD COMP ORPHAN BLOOD BANK","BB")

 +13       IF 'X

               WRITE "Attempt to add Orphaned Blood Bank visit option failed."

               HANG 3

 +14       SET X=$$ADD^XPDMENU("APCD ORPHANED VISIT MENU","APCD COMPLETE MICRO VISITS","MIC")

 +15       IF 'X

               WRITE "Attempt to add Orphaned Microbiology visit option failed."

               HANG 3

 +16       SET X=$$ADD^XPDMENU("APCD LTM MENU","APCD TABLE CLINIC LIST","CL")

 +17       IF 'X

               WRITE "Attempt to add clinic list visit option failed."

               HANG 3

 +18       SET X=$$ADD^XPDMENU("APCDMENU","APCD PRINT PCC VISIT","PDV")

 +19       IF 'X

               WRITE "Attempt to add Print PCC form option failed."

               HANG 3

 +20       SET X=$$ADD^XPDMENU("APCD MENU UTILITIES","APCDVMDD","MR2")

 +21       IF 'X

               WRITE "Attempt to add Merge 2 visits/2 days option failed."

               HANG 3

 +22       SET X=$$ADD^XPDMENU("APCD MENU UTILITIES","APCD REPRINT GROUP FORMS","RGF")

 +23       IF 'X

               WRITE "Attempt to add re-print group forms option failed."

               HANG 3

 +24       DO AST

 +25       DO CC

 +26       DO COC

 +27       DO PCF

 +28       DO PF

 +29       DO HAST

 +30       DO O2

 +31       DO PA

 +32       DO CEF

 +33       DO IIM

 +34       DO HRX

 +35       DO ALG

 +36       DO HHF

 +37       DO UAS

 +38       DO ADA

 +39       DO HADA

 +40       DO ^APCDBUL7

 +41       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 

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 

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 

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///PCC+ Form;.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 

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       ;