- 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 Mar 13, 2025@21:31:37 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
