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 ;
