APCD20P6.m

APCD20P6 ; IHS/CMI/TUCSON - DATA ENTRY PATCH 4 [ 04/07/03  7:25 AM ]

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

 I '$O(^DIC(19,"B","APCD ORPHANED VISIT MENU",0)) D

 .D RENAME^XPDMENU("APCD ORPHANED LAB MENU","APCD ORPHANED VISIT MENU")

 Q

POST ;

 D ^APC6INIT

 NEW X

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

 D HRX

 D ^APCD206F

 D ^APCDBUL5

 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

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

 ;

APCD20P6  ; IHS/CMI/TUCSON - DATA ENTRY PATCH 4 [ 04/07/03  7:25 AM ]

 +1       ;;2.0;IHS RPMS/PCC Data Entry;**4,5,6**;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        IF '$ORDER(^DIC(19,"B","APCD ORPHANED VISIT MENU",0))

               Begin DoDot:1

 +2                DO RENAME^XPDMENU("APCD ORPHANED LAB MENU","APCD ORPHANED VISIT MENU")

               End DoDot:1

 +3        QUIT 

POST      ;

 +1        DO ^APC6INIT

 +2        NEW X

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

 +4        IF 'X

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

               HANG 3

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

 +6        IF 'X

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

               HANG 3

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

 +8        IF 'X

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

               HANG 3

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

 +10       IF 'X

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

               HANG 3

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

 +12       IF 'X

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

               HANG 3

 +13       DO AST

 +14       DO CC

 +15       DO COC

 +16       DO PCF

 +17       DO PF

 +18       DO HAST

 +19       DO O2

 +20       DO PA

 +21       DO IIM

 +22       DO HRX

 +23       DO ^APCD206F

 +24       DO ^APCDBUL5

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

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       ;