source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OR3C100A.m@ 1397

OR3C100A ; SLC/MKB - Orders file conversion cont ;8/8/97  15:28
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**14**;Dec 17, 1997
EN ; -- continue here
 I '$L($T(@ORPKG)) S ORQUIT=1 Q
 G @ORPKG
 Q
 ;
PTR(X) ; -- Returns ptr to 101.41 for prompt OR GTX X
 Q +$O(^ORD(101.41,"AB",$E("OR GTX "_X,1,63),0))
 ;
LR ; -- Lab
 N TEST,START,SAMP,SPEC,TYPE,URG,OI
 S TEST=$P(ORPK,U),START=$P(ORPK,U,2),SAMP=$P(ORPK,U,3),SPEC=$P(ORPK,U,4),TYPE=$P(ORPK,U,5),URG=$P(ORPK,U,6)
 I 'TEST S ORQUIT=1 Q
 S OI=$O(^ORD(101.43,"ID",TEST_";99LRT",0)) I 'OI S ORQUIT=1 Q
 S ORDIALOG=+$O(^ORD(101.41,"AB","LR OTHER LAB TESTS",0))
 D GETDLG1^ORCD(ORDIALOG) I '$O(ORDIALOG(0)) S ORQUIT=1 Q
 S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
 S:SAMP ORDIALOG($$PTR("COLLECTION SAMPLE"),1)=SAMP
 S:SPEC ORDIALOG($$PTR("SPECIMEN"),1)=SPEC
 S:$L(TYPE) ORDIALOG($$PTR("COLLECTION TYPE"),1)=TYPE
 S:START ORDIALOG($$PTR("START DATE/TIME"),1)=START
 S:URG ORDIALOG($$PTR("LAB URGENCY"),1)=URG
 Q
 ;
RA ; -- Radiology
 N PROC,CATG,URG,CONTR,PREOP,PREG,MODE,ILOC,START,OI,X,Y,WP,MOD,STS,DA,DIK
 S X=$G(^RAO(75.1,+ORPK,0)) I '$L(X) S ORQUIT=1 Q
 S STS=$P(X,U,5) I STS,STS'=11 S $P(^OR(100,ORIFN,3),U,3)=STS,ORQUIT=1 Q
 S PROC=$P(X,U,2),CATG=$P(X,U,4),URG=$P(X,U,6),CONTR=$P(X,U,9),PREOP=$P(X,U,12),PREG=$P(X,U,13),MODE=$P(X,U,19),ILOC=$P(X,U,20),START=$P(X,U,21)
 I 'PROC S ORQUIT=1 Q
 S OI=$O(^ORD(101.43,"ID",PROC_";99RAP",0)) I 'OI S ORQUIT=1 Q
 S ORDIALOG=+$O(^ORD(101.41,"AB","RA OERR EXAM",0))
 D GETDLG1^ORCD(ORDIALOG) I '$O(ORDIALOG(0)) S ORQUIT=1 Q
 S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
 S:START ORDIALOG($$PTR("START DATE/TIME"),1)=START
 S:URG ORDIALOG($$PTR("URGENCY"),1)=URG
 S:$L(MODE) ORDIALOG($$PTR("MODE OF TRANSPORT"),1)=$$UP^XLFSTR(MODE)
 S:$L(CATG) ORDIALOG($$PTR("CATEGORY"),1)=CATG
 S:(CATG="I")!(CATG="O") ORCAT=CATG
 I (CATG="C")!(CATG="S") S:CONTR ORDIALOG($$PTR("CONTRACT/SHARING SOURCE"),1)=CONTR
 I CATG="R" S X=$G(^RAO(75.1,+ORPK,"R")) S:$L(X) ORDIALOG($$PTR("RESEARCH SOURCE"),1)=X
 S:PREOP ORDIALOG($$PTR("PRE-OP SCHEDULED DATE/TIME"),1)=PREOP
 S:$L(PREG) ORDIALOG($$PTR("PREGNANT"),1)=$$UP^XLFSTR(PREG)
 S:ILOC ORDIALOG($$PTR("IMAGING LOCATION"),1)=ILOC
 S MOD=$$PTR("MODIFIERS"),(X,Y)=0 F  S Y=$O(^RAO(75.1,+ORPK,"M",Y)) Q:Y'>0  S X=X+1,ORDIALOG(MOD,X)=+$G(^(Y,0))
 I $D(^RAO(75.1,+ORPK,"H")) S WP=$$PTR("WORD PROCESSING 1"),ORDIALOG(WP,1)="^TMP(""ORWORD"",$J,"_WP_",1)" M ^TMP("ORWORD",$J,WP,1)=^RAO(75.1,+ORPK,"H")
 I '$D(^RADPT("AO",+ORPK)) S DA=+ORPK,DIK="^RAO(75.1," D ^DIK
 Q
 ;
GMRC ; -- Consults
 N PROC,TO,CATG,URG,PLACE,ATTN,TYPE,DX,WP,OI,X,Y,DA,DIK
 S X=$G(^GMR(123,+ORPK,0)) I '$L(X) S ORQUIT=1 Q
 S TO=$P(X,U,5),URG=$P(X,U,9),PLACE=$P(X,U,10),ATTN=$P(X,U,11),TYPE=$P(X,U,17),CATG=$P(X,U,18),DX=$G(^GMR(123,+ORPK,30)),PROC=""
 S Y=$P($G(^ORD(101,+TYPE,0)),U) I Y'?1"GMRCOR ".E S ORQUIT=1 Q
 S ORDIALOG=+$O(^ORD(101.41,"AB",Y,0)) I 'ORDIALOG S ORQUIT=1 Q
 I Y="GMRCOR REQUEST" S PROC=$P(X,U,8) I 'PROC S ORQUIT=1 Q
 D GETDLG1^ORCD(ORDIALOG) I '$O(ORDIALOG(0)) S ORQUIT=1 Q
 S OI=$S(PROC:PROC_";99PRO",1:TO_";99CON")
 S OI=$O(^ORD(101.43,"ID",OI,0)) I 'OI S ORQUIT=1 Q
 S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
 S URG=$P($P($G(^ORD(101,+URG,0)),U)," - ",2) S:(URG="NOW")!(URG="EMERGENCY") URG="ASAP" S:(URG="INPATIENT")!(URG="") URG="ROUTINE"
 S Y=$O(^ORD(101.42,"B",URG,0)) S:Y ORDIALOG($$PTR("URGENCY"),1)=Y
 S PLACE=$P($P($G(^ORD(101,+PLACE,0)),U)," - ",2),Y=$S(PLACE="BEDSIDE":"B",PLACE="EMERGENCY ROOM":"E",PLACE="ON CALL":"C",1:"")
 S:$L(Y) ORDIALOG($$PTR("PLACE OF CONSULTATION"),1)=Y
 S:$L(CATG) ORDIALOG($$PTR("CATEGORY"),1)=CATG
 S:ATTN ORDIALOG($$PTR("PROVIDER"),1)=ATTN
 S:$L(DX) ORDIALOG($$PTR("FREE TEXT"),1)=DX
 I $D(^GMR(123,+ORPK,20)) S WP=$$PTR("WORD PROCESSING 1"),ORDIALOG(WP,1)="^TMP(""ORWORD"",$J,"_WP_",1)" M ^TMP("ORWORD",$J,WP,1)=^GMR(123,+ORPK,20)
 S DA=+ORPK,DIK="^GMR(123," D ^DIK
 Q
 ;
OR ; -- Generic orders
 I $P(^OR(100,ORIFN,0),U,11)'=$O(^ORD(100.98,"B","V/M",0)) S ORQUIT=1 Q  ; Vitals only
GMRV ; -- Vitals
 N START,STOP,SCH,TEXT,DLG,X,Y,I,OI
 S START=$P(ORPK,U),STOP=$P(ORPK,U,2),SCH=$P(ORPK,U,3),TEXT=$P(ORPK,U,4)
 S X=$P($G(^ORD(101,+$P(OR0,U,5),0)),U) I '$L(X) S ORQUIT=1 Q
 S DLG=$O(^ORD(101.41,"AB",X,0)) I 'DLG S ORQUIT=1 Q
 S OI=$$PTR("ORDERABLE ITEM"),I=$O(^ORD(101.41,+DLG,6,"D",OI,0))
 S Y=+$G(^ORD(101.41,+DLG,6,+I,1)) I 'Y S ORQUIT=1 Q
 S ORDIALOG=+$O(^ORD(101.41,"AB","GMRVOR",0)) D GETDLG1^ORCD(ORDIALOG)
 S ORDIALOG(OI,1)=Y
 S:START ORDIALOG($$PTR("START DATE/TIME"),1)=START
 S:STOP ORDIALOG($$PTR("STOP DATE/TIME"),1)=STOP
 S:$L(SCH) ORDIALOG($$PTR("SCHEDULE"),1)=SCH
 S:$L(TEXT) ORDIALOG($$PTR("FREE TEXT 1"),1)=TEXT
 Q
 ;
FH ; -- Dietetics
 N X S X=$P($G(^ORD(101,+$P(OR0,U,5),0)),U)
 I (X="FHW6")!(X'?1"FHW"1N) S ORQUIT=1 Q
 G 1:X="FHW1",2:X="FHW2",3:X="FHW3",4:X="FHW4",7:X="FHW7",8:X="FHW8"
 S ORQUIT=1
 Q
1 ; -- Diet order
 N OI,I,P,X,Y
 S ORDIALOG=+$O(^ORD(101.41,"AB","FHW1",0)) D GETDLG1^ORCD(ORDIALOG)
 S OI=$$PTR("ORDERABLE ITEM"),I=0
 F P=9:1:13 S X=$P(ORPK,U,P) Q:'X  S Y=$O(^ORD(101.43,"ID",X_";99FHD",0)) S:Y I=I+1,ORDIALOG(OI,I)=Y
 I 'I S ORQUIT=1 Q  ; no diets found
 S:$P(ORPK,U,3) ORDIALOG($$PTR("START DATE/TIME"),1)=$P(ORPK,U,3)
 S:$P(ORPK,U,4) ORDIALOG($$PTR("STOP DATE/TIME"),1)=$P(ORPK,U,4)
 S:$L($P(ORPK,U,7)) ORDIALOG($$PTR("DELIVERY"),1)=$P(ORPK,U,7)
 S:$L($P(ORPK,U,6)) ORDIALOG($$PTR("FREE TEXT 1"),1)=$P(ORPK,U,6)
 Q
2 ; -- Early/late tray
 N ORPARAM,MEAL,TIME,I,X,Y,OI
 D EN^FHWOR8(+ORVP,.ORPARAM) I '$L($G(ORPARAM(1))) S ORQUIT=1 Q
 S MEAL=$P(ORPK,U,6),TIME=$P(ORPK,U,7) I '$L(MEAL)!('TIME) S ORQUIT=1 Q
 S I=$S(MEAL="B":1,MEAL="N":7,MEAL="E":13,1:0) I 'I S ORQUIT=1 Q
 S X=$P(ORPARAM(1),U,I,I+5),Y=""
 F I=1:1:6 I $P(X,U,I)=TIME S Y=$S(I<4:"EARLY TRAY",1:"LATE TRAY")
 I '$L(Y) S ORQUIT=1 Q
 S ORDIALOG=+$O(^ORD(101.41,"AB","FHW2",0)) D GETDLG1^ORCD(ORDIALOG)
 S OI=+$O(^ORD(101.43,"S.E/L T",Y,0)),ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
 S ORDIALOG($$PTR("MEAL"),1)=MEAL,ORDIALOG($$PTR("MEAL TIME"),1)=TIME
 S:$P(ORPK,U,3) ORDIALOG($$PTR("START DATE"),1)=$P($P(ORPK,U,3),".")
 S:$P(ORPK,U,4) ORDIALOG($$PTR("STOP DATE"),1)=$P($P(ORPK,U,4),".")
 S:$L($P(ORPK,U,5)) ORDIALOG($$PTR("SCHEDULE"),1)=$P(ORPK,U,5)
 S:$L($P(ORPK,U,8)) ORDIALOG($$PTR("YES/NO"),1)=($P(ORPK,U,8)="Y")
 Q
3 ; -- Isolation
 S ORDIALOG=+$O(^ORD(101.41,"AB","FHW3",0))
 D GETDLG1^ORCD(ORDIALOG)
 N OI S OI=+$O(^ORD(101.43,"S.PREC","ISOLATION PROCEDURES",0))
 S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
 S:$P(ORPK,U,2) ORDIALOG($$PTR("ISOLATION TYPE"),1)=$P(ORPK,U,2)
 Q
4 ; -- NPO
 S ORDIALOG=+$O(^ORD(101.41,"AB","FHW4",0)) D GETDLG1^ORCD(ORDIALOG)
 N OI S OI=+$O(^ORD(101.43,"S.DIET","NPO",0))
 S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
 S:$P(ORPK,U,3) ORDIALOG($$PTR("START DATE/TIME"),1)=$P(ORPK,U,3)
 S:$P(ORPK,U,4) ORDIALOG($$PTR("STOP DATE/TIME"),1)=$P(ORPK,U,4)
 S:$L($P(ORPK,U,6)) ORDIALOG($$PTR("FREE TEXT 1"),1)=$P(ORPK,U,6)
 Q
7 ; -- Additional order
 S ORDIALOG=+$O(^ORD(101.41,"AB","FHW7",0)) D GETDLG1^ORCD(ORDIALOG)
 S:$L($P(ORPK,U,3)) ORDIALOG($$PTR("FREE TEXT 1"),1)=$P(ORPK,U,3)
 Q
8 ; -- Tubefeeding
 N PROD,OI,I,X,Y
 S ORDIALOG=+$O(^ORD(101.41,"AB","FHW8",0)) D GETDLG1^ORCD(ORDIALOG)
 F I=2:1:6 S PROD=$P(ORPK,"~",I) Q:PROD=""  D  Q:$G(ORQUIT)
 . S OI=+$O(^ORD(101.43,"ID",+$P(PROD,U)_";99FHT",0)) I 'OI S ORQUIT=1 Q
 . S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
 . S:$P(PROD,U,2) ORDIALOG($$PTR("STRENGTH FH"),1)=$P(PROD,U,2)
 . I $L($P(PROD,U,3)) D  S ORDIALOG($$PTR("INSTRUCTIONS"),1)=Y
 . . S X=$P(PROD,U,3),Y=$P(X,"/") Q:$L(X,"/")'>1  ;done
 . . S X=$P(X,"/",2),Y=Y_"/"_$S(X="per Day":"QD",X="per Hour":"QH",X="Twice a Day":"BID",X="Three times a Day":"TID",X="Every 2 Hours":"Q2H",X="Every 3 Hours":"Q3H",X="Every 4 Hours":"Q4H",X="Every 6 Hours":"Q6H",1:"")
 S:$L($P(ORPK,U,5)) ORDIALOG($$PTR("FREE TEXT 1"),1)=$P(ORPK,U,5)
 S:$L($P(ORPK,U,6)) ORDIALOG($$PTR("CANCEL FUTURE ORDERS"),1)=$P(ORPK,U,6)
 Q