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