ORCONV2 ; SLC/MKB - Convert protocols/menus to Dialogs cont ;6/10/97 10:40
;;3.0;ORDER ENTRY/RESULTS REPORTING;**14**;Dec 17, 1997
FH ; -- process Diet PITEM
; default Diet Order dialog = FHW1
N DEFAULT,DIETS,CODE,Z,X,Y,OI,DFLT,I,QUOTE,ERR,INST,CNT,PKG
I NAME="FHW5" S DITEM=$O(^ORD(101.41,"AB","GMRAOR ALLERGY ENTER/EDIT",0)) Q
I NAME="FHW6" S DITEM=$O(^ORD(101.41,"AB","GMRCOR CONSULT",0)) Q
; G:NAME'?1"FHWD"1.N NONSTD^ORCONVRT ; not a quick order
S CODE=$G(^ORD(101,PITEM,20)),Z=$F(CODE,"FHOR=")
S:'Z CODE="S FHOR="_+$E(NAME,5,99),Z=7
S DIETS=$E(CODE,Z,999),DIETS=$P(DIETS," "),QUOTE=""""
S:$E(DIETS)=QUOTE DIETS=$P(DIETS,QUOTE,2) ; ="#^^^^"
S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
S DEFAULT=$O(^ORD(101.41,"AB","FHW1",0)),PKG=$O(^DIC(9.4,"C","FH",0))
S X=^ORD(101.41,DITEM,0),X=X_"^^Q^"_$P(^ORD(101.41,DEFAULT,0),U,5)_U_$S('+$G(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0",^ORD(101.41,DITEM,0)=X
S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
K ^ORD(101.41,DITEM,6)
FH1 ; save diet(s) into DIET prompt
S INST=0 F I=1:1:$L(DIETS,"^") S X=$P(DIETS,U,I) I X D
. S OI=$O(^ORD(101.43,"ID",X_";99FHD",0)) I 'OI S ERR=1 Q
. I $$INACTIVE^ORCONVRT(OI) S ERR=1 Q
. S INST=INST+1 D SET^ORCONVRT("ORDERABLE ITEM",OI,INST)
S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
G:$G(ERR) OI^ORCONVRT ; incomplete OI's
Q
;
LR ; -- process Lab PITEM
; default Lab Order dialog = LR OTHER LAB TESTS
N DEFAULT,IFN,OI,SAMP,SPEC,DA,CODE,Z,ZZ,X,CNT,PKG
I TYPE="L" S OI=$$LRTEST(PITEM) G LR1
S DA=0 F S DA=$O(^ORD(101,PITEM,10,DA)) Q:DA'>0 S IFN=+$P(^(DA,0),U) D
. N NAME,FLINK S NAME=$P($G(^ORD(101,IFN,0)),U),FLINK=$P($G(^(5)),U)
. I NAME?1"LR ".E,FLINK?1.N1";LAB(60," S OI=$$LRTEST(IFN)
. I NAME?1"LRD ".E,FLINK?1.N1";LAB(62," S SAMP=+FLINK
. I NAME?1"LRS ".E,FLINK?1.N1";LAB(61," S SPEC=+FLINK
LR1 G:'$D(OI) NONSTD^ORCONVRT
G:'OI OI^ORCONVRT G:$$INACTIVE^ORCONVRT(OI) OI^ORCONVRT
S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
K ^ORD(101.41,DITEM,6) S PKG=$O(^DIC(9.4,"C","LR",0))
S DEFAULT=$O(^ORD(101.41,"AB","LR OTHER LAB TESTS",0))
S X=^ORD(101.41,DITEM,0),X=X_"^^Q^"_$P(^ORD(101.41,DEFAULT,0),U,5)_U_$S('+$G(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0",^ORD(101.41,DITEM,0)=X
S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
D SET^ORCONVRT("ORDERABLE ITEM",OI) S CODE=$G(^ORD(101,PITEM,20))
D I $G(SAMP) D SET^ORCONVRT("COLLECTION SAMPLE",SAMP)
. I '$G(SAMP) S Z=$F(CODE,"LRFSAMP=") S:Z SAMP=+$$VALUE^ORCONVRT(CODE,Z)
. K:'$D(^LAB(62,+$G(SAMP),0)) SAMP
D I $G(SPEC) D SET^ORCONVRT("SPECIMEN",SPEC)
. I '$G(SPEC) S Z=$F(CODE,"LRFSPEC=") S:Z SPEC=$$VALUE^ORCONVRT(CODE,Z)
. K:'$D(^LAB(61,+$G(SPEC),0)) SPEC
S Z=$F(CODE,"LRFZX=") I Z S ZZ=$$VALUE^ORCONVRT(CODE,Z) D SET^ORCONVRT("COLLECTION TYPE",ZZ)
S Z=$F(CODE,"LRFURG=") I Z S ZZ=+$E(CODE,Z,999) D:ZZ SET^ORCONVRT("LAB URGENCY",ZZ)
LR2 S Z=$F(CODE,"LRFDATE=") I Z D D SET^ORCONVRT("START DATE/TIME",ZZ):$L(ZZ),STRTDT^ORCONVRT:'$L(ZZ)
. N X,Y,%DT,X1,X2
. S X=$$VALUE^ORCONVRT(CODE,Z),ZZ="" Q:'$L(X) S:X="DT" X="TODAY"
. I X="%",CODE["NOW^%DTC" S X="NOW"
. S:X="$$NOW^XLFDT" X="NOW" S:X="$$DT^XLFDT" X="TODAY"
. I X="X",CODE["C^%DTC" S X1=$F(CODE,"X1=") Q:'X1 S X1=$$VALUE^ORCONVRT(CODE,X1) Q:'$S(X1="DT":1,X1="$$DT^XLFDT":1,1:0) S X2=$F(CODE,"X2=") Q:'X2 S X2=$$VALUE^ORCONVRT(CODE,X2) S:X2>0 X="T+"_(+X2)
. S %DT="FTX" D ^%DT S:Y>0 ZZ=X ; valid
S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
Q
;
LRTEST(TEST) ; -- Returns Orderable Item ptr for protocol TEST
N PTR,OI
S PTR=+$G(^ORD(101,TEST,5)),OI=$O(^ORD(101.43,"ID",PTR_";99LRT",0))
Q +OI
;
IV ; -- process IV med PITEM
N DEFAULT,X,INST,OI,ADD,SOL,RATE,ARRAY,CNT,PROVCOMM,PKG
S DEFAULT=$O(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0)),PKG=$O(^DIC(9.4,"C","PSIV",0))
S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
S X=^ORD(101.41,DITEM,0),X=X_"^^Q^"_$P(^ORD(101.41,DEFAULT,0),U,5)_U_$S('+$G(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0",^ORD(101.41,DITEM,0)=X
S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
S INST=0 F S INST=$O(^TMP("PSJQO",$J,"SOL",INST)) Q:INST'>0 S SOL=$G(^(INST,0)) D
. S OI=$O(^ORD(101.43,"ID",$P(SOL,U)_";99PSP",0)) Q:'OI
. D SET^ORCONVRT("ORDERABLE ITEM",OI,INST)
. D SET^ORCONVRT("VOLUME",+$P(SOL,U,2),INST)
S INST=0 F S INST=$O(^TMP("PSJQO",$J,"AD",INST)) Q:INST'>0 S ADD=$G(^(INST,0)) D
. S OI=$O(^ORD(101.43,"ID",$P(ADD,U)_";99PSP",0)) Q:'OI
. D SET^ORCONVRT("ADDITIVE",OI,INST)
. D SET^ORCONVRT("STRENGTH PSIV",$P(ADD,U,2),INST)
. D SET^ORCONVRT("UNITS",$P(ADD,U,3),INST)
S RATE=$P(^TMP("PSJQO",$J,1),U,7),PROVCOMM=$P(^(1),U,8)
D:$L(RATE) SET^ORCONVRT("INFUSION RATE",RATE)
S:PROVCOMM ^ORD(101.41,DITEM,3)="S PSJNOPC=1"
I $G(^TMP("PSJQO",$J,"PC",0)) D ; comments
. S X=^TMP("PSJQO",$J,"PC",0),X="^^"_X_U_DT_U,^(0)=X
. S ARRAY="^TMP(""PSJQO"","_$J_",""PC"")"
. D SET^ORCONVRT("WORD PROCESSING 1",ARRAY)
S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
Q
;
UD ; -- process Unit Dose PITEM
N DEFAULT,X,PSOI,OI,ARRAY,CNT,PKG
S DEFAULT=$O(^ORD(101.41,"AB","PSJ OR PAT OE",0)),PKG=$O(^DIC(9.4,"C","PSJ",0))
S DITEM=$$DIALOG^ORCONVRT(PITEM) G:'DITEM DLG^ORCONVRT
S X=^ORD(101.41,DITEM,0),X=X_"^^Q^"_$P(^ORD(101.41,DEFAULT,0),U,5)_U_$S('+$G(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0",^ORD(101.41,DITEM,0)=X
S:PKG ^ORD(101.41,"APKG",+PKG,DITEM)=""
S X=$G(^TMP("PSJQO",$J,1)),PSOI=$P(X,U,3),CNT=0
I PSOI S OI=$O(^ORD(101.43,"ID",PSOI_";99PSP",0)) I OI G:$$INACTIVE^ORCONVRT(OI) OI^ORCONVRT D SET^ORCONVRT("ORDERABLE ITEM",OI)
I +$G(^TMP("PSJQO",$J,"DD")) D SET^ORCONVRT("DISPENSE DRUG",^("DD"))
D:$L($P(X,U,6)) SET^ORCONVRT("INSTRUCTIONS",$P(X,U,6))
D:$P(X,U,4) SET^ORCONVRT("ROUTE",$P(X,U,4))
D:$L($P(X,U,5)) SET^ORCONVRT("SCHEDULE",$P(X,U,5))
I $P(X,U,8) S ^ORD(101.41,DITEM,3)="S PSJNOPC=1"
I $G(^TMP("PSJQO",$J,"PC",0)) D ; comments
. S X=^TMP("PSJQO",$J,"PC",0),X="^^"_X_U_DT_U,^(0)=X
. S ARRAY="^TMP(""PSJQO"","_$J_",""PC"")"
. D SET^ORCONVRT("WORD PROCESSING 1",ARRAY)
S:$G(CNT) ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCONV2 6092 printed Nov 22, 2024@17:38:50 Page 2
ORCONV2 ; SLC/MKB - Convert protocols/menus to Dialogs cont ;6/10/97 10:40
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**14**;Dec 17, 1997
FH ; -- process Diet PITEM
+1 ; default Diet Order dialog = FHW1
+2 NEW DEFAULT,DIETS,CODE,Z,X,Y,OI,DFLT,I,QUOTE,ERR,INST,CNT,PKG
+3 IF NAME="FHW5"
SET DITEM=$ORDER(^ORD(101.41,"AB","GMRAOR ALLERGY ENTER/EDIT",0))
QUIT
+4 IF NAME="FHW6"
SET DITEM=$ORDER(^ORD(101.41,"AB","GMRCOR CONSULT",0))
QUIT
+5 ; G:NAME'?1"FHWD"1.N NONSTD^ORCONVRT ; not a quick order
+6 SET CODE=$GET(^ORD(101,PITEM,20))
SET Z=$FIND(CODE,"FHOR=")
+7 if 'Z
SET CODE="S FHOR="_+$EXTRACT(NAME,5,99)
SET Z=7
+8 SET DIETS=$EXTRACT(CODE,Z,999)
SET DIETS=$PIECE(DIETS," ")
SET QUOTE=""""
+9 ; ="#^^^^"
if $EXTRACT(DIETS)=QUOTE
SET DIETS=$PIECE(DIETS,QUOTE,2)
+10 SET DITEM=$$DIALOG^ORCONVRT(PITEM)
if 'DITEM
GOTO DLG^ORCONVRT
+11 SET DEFAULT=$ORDER(^ORD(101.41,"AB","FHW1",0))
SET PKG=$ORDER(^DIC(9.4,"C","FH",0))
+12 SET X=^ORD(101.41,DITEM,0)
SET X=X_"^^Q^"_$PIECE(^ORD(101.41,DEFAULT,0),U,5)_U_$SELECT('+$GET(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0"
SET ^ORD(101.41,DITEM,0)=X
+13 if PKG
SET ^ORD(101.41,"APKG",+PKG,DITEM)=""
+14 KILL ^ORD(101.41,DITEM,6)
FH1 ; save diet(s) into DIET prompt
+1 SET INST=0
FOR I=1:1:$LENGTH(DIETS,"^")
SET X=$PIECE(DIETS,U,I)
IF X
Begin DoDot:1
+2 SET OI=$ORDER(^ORD(101.43,"ID",X_";99FHD",0))
IF 'OI
SET ERR=1
QUIT
+3 IF $$INACTIVE^ORCONVRT(OI)
SET ERR=1
QUIT
+4 SET INST=INST+1
DO SET^ORCONVRT("ORDERABLE ITEM",OI,INST)
End DoDot:1
+5 if $GET(CNT)
SET ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
+6 ; incomplete OI's
if $GET(ERR)
GOTO OI^ORCONVRT
+7 QUIT
+8 ;
LR ; -- process Lab PITEM
+1 ; default Lab Order dialog = LR OTHER LAB TESTS
+2 NEW DEFAULT,IFN,OI,SAMP,SPEC,DA,CODE,Z,ZZ,X,CNT,PKG
+3 IF TYPE="L"
SET OI=$$LRTEST(PITEM)
GOTO LR1
+4 SET DA=0
FOR
SET DA=$ORDER(^ORD(101,PITEM,10,DA))
if DA'>0
QUIT
SET IFN=+$PIECE(^(DA,0),U)
Begin DoDot:1
+5 NEW NAME,FLINK
SET NAME=$PIECE($GET(^ORD(101,IFN,0)),U)
SET FLINK=$PIECE($GET(^(5)),U)
+6 IF NAME?1"LR ".E
IF FLINK?1.N1";LAB(60,"
SET OI=$$LRTEST(IFN)
+7 IF NAME?1"LRD ".E
IF FLINK?1.N1";LAB(62,"
SET SAMP=+FLINK
+8 IF NAME?1"LRS ".E
IF FLINK?1.N1";LAB(61,"
SET SPEC=+FLINK
End DoDot:1
LR1 if '$DATA(OI)
GOTO NONSTD^ORCONVRT
+1 if 'OI
GOTO OI^ORCONVRT
if $$INACTIVE^ORCONVRT(OI)
GOTO OI^ORCONVRT
+2 SET DITEM=$$DIALOG^ORCONVRT(PITEM)
if 'DITEM
GOTO DLG^ORCONVRT
+3 KILL ^ORD(101.41,DITEM,6)
SET PKG=$ORDER(^DIC(9.4,"C","LR",0))
+4 SET DEFAULT=$ORDER(^ORD(101.41,"AB","LR OTHER LAB TESTS",0))
+5 SET X=^ORD(101.41,DITEM,0)
SET X=X_"^^Q^"_$PIECE(^ORD(101.41,DEFAULT,0),U,5)_U_$SELECT('+$GET(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0"
SET ^ORD(101.41,DITEM,0)=X
+6 if PKG
SET ^ORD(101.41,"APKG",+PKG,DITEM)=""
+7 DO SET^ORCONVRT("ORDERABLE ITEM",OI)
SET CODE=$GET(^ORD(101,PITEM,20))
+8 Begin DoDot:1
+9 IF '$GET(SAMP)
SET Z=$FIND(CODE,"LRFSAMP=")
if Z
SET SAMP=+$$VALUE^ORCONVRT(CODE,Z)
+10 if '$DATA(^LAB(62,+$GET(SAMP),0))
KILL SAMP
End DoDot:1
IF $GET(SAMP)
DO SET^ORCONVRT("COLLECTION SAMPLE",SAMP)
+11 Begin DoDot:1
+12 IF '$GET(SPEC)
SET Z=$FIND(CODE,"LRFSPEC=")
if Z
SET SPEC=$$VALUE^ORCONVRT(CODE,Z)
+13 if '$DATA(^LAB(61,+$GET(SPEC),0))
KILL SPEC
End DoDot:1
IF $GET(SPEC)
DO SET^ORCONVRT("SPECIMEN",SPEC)
+14 SET Z=$FIND(CODE,"LRFZX=")
IF Z
SET ZZ=$$VALUE^ORCONVRT(CODE,Z)
DO SET^ORCONVRT("COLLECTION TYPE",ZZ)
+15 SET Z=$FIND(CODE,"LRFURG=")
IF Z
SET ZZ=+$EXTRACT(CODE,Z,999)
if ZZ
DO SET^ORCONVRT("LAB URGENCY",ZZ)
LR2 SET Z=$FIND(CODE,"LRFDATE=")
IF Z
Begin DoDot:1
+1 NEW X,Y,%DT,X1,X2
+2 SET X=$$VALUE^ORCONVRT(CODE,Z)
SET ZZ=""
if '$LENGTH(X)
QUIT
if X="DT"
SET X="TODAY"
+3 IF X="%"
IF CODE["NOW^%DTC"
SET X="NOW"
+4 if X="$$NOW^XLFDT"
SET X="NOW"
if X="$$DT^XLFDT"
SET X="TODAY"
+5 IF X="X"
IF CODE["C^%DTC"
SET X1=$FIND(CODE,"X1=")
if 'X1
QUIT
SET X1=$$VALUE^ORCONVRT(CODE,X1)
if '$SELECT(X1="DT"
QUIT
SET X2=$FIND(CODE,"X2=")
if 'X2
QUIT
SET X2=$$VALUE^ORCONVRT(CODE,X2)
if X2>0
SET X="T+"_(+X2)
+6 ; valid
SET %DT="FTX"
DO ^%DT
if Y>0
SET ZZ=X
End DoDot:1
if $LENGTH(ZZ)
DO SET^ORCONVRT("START DATE/TIME",ZZ)
if '$LENGTH(ZZ)
DO STRTDT^ORCONVRT
+7 if $GET(CNT)
SET ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
+8 QUIT
+9 ;
LRTEST(TEST) ; -- Returns Orderable Item ptr for protocol TEST
+1 NEW PTR,OI
+2 SET PTR=+$GET(^ORD(101,TEST,5))
SET OI=$ORDER(^ORD(101.43,"ID",PTR_";99LRT",0))
+3 QUIT +OI
+4 ;
IV ; -- process IV med PITEM
+1 NEW DEFAULT,X,INST,OI,ADD,SOL,RATE,ARRAY,CNT,PROVCOMM,PKG
+2 SET DEFAULT=$ORDER(^ORD(101.41,"AB","PSJI OR PAT FLUID OE",0))
SET PKG=$ORDER(^DIC(9.4,"C","PSIV",0))
+3 SET DITEM=$$DIALOG^ORCONVRT(PITEM)
if 'DITEM
GOTO DLG^ORCONVRT
+4 SET X=^ORD(101.41,DITEM,0)
SET X=X_"^^Q^"_$PIECE(^ORD(101.41,DEFAULT,0),U,5)_U_$SELECT('+$GET(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0"
SET ^ORD(101.41,DITEM,0)=X
+5 if PKG
SET ^ORD(101.41,"APKG",+PKG,DITEM)=""
+6 SET INST=0
FOR
SET INST=$ORDER(^TMP("PSJQO",$JOB,"SOL",INST))
if INST'>0
QUIT
SET SOL=$GET(^(INST,0))
Begin DoDot:1
+7 SET OI=$ORDER(^ORD(101.43,"ID",$PIECE(SOL,U)_";99PSP",0))
if 'OI
QUIT
+8 DO SET^ORCONVRT("ORDERABLE ITEM",OI,INST)
+9 DO SET^ORCONVRT("VOLUME",+$PIECE(SOL,U,2),INST)
End DoDot:1
+10 SET INST=0
FOR
SET INST=$ORDER(^TMP("PSJQO",$JOB,"AD",INST))
if INST'>0
QUIT
SET ADD=$GET(^(INST,0))
Begin DoDot:1
+11 SET OI=$ORDER(^ORD(101.43,"ID",$PIECE(ADD,U)_";99PSP",0))
if 'OI
QUIT
+12 DO SET^ORCONVRT("ADDITIVE",OI,INST)
+13 DO SET^ORCONVRT("STRENGTH PSIV",$PIECE(ADD,U,2),INST)
+14 DO SET^ORCONVRT("UNITS",$PIECE(ADD,U,3),INST)
End DoDot:1
+15 SET RATE=$PIECE(^TMP("PSJQO",$JOB,1),U,7)
SET PROVCOMM=$PIECE(^(1),U,8)
+16 if $LENGTH(RATE)
DO SET^ORCONVRT("INFUSION RATE",RATE)
+17 if PROVCOMM
SET ^ORD(101.41,DITEM,3)="S PSJNOPC=1"
+18 ; comments
IF $GET(^TMP("PSJQO",$JOB,"PC",0))
Begin DoDot:1
+19 SET X=^TMP("PSJQO",$JOB,"PC",0)
SET X="^^"_X_U_DT_U
SET ^(0)=X
+20 SET ARRAY="^TMP(""PSJQO"","_$JOB_",""PC"")"
+21 DO SET^ORCONVRT("WORD PROCESSING 1",ARRAY)
End DoDot:1
+22 if $GET(CNT)
SET ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
+23 QUIT
+24 ;
UD ; -- process Unit Dose PITEM
+1 NEW DEFAULT,X,PSOI,OI,ARRAY,CNT,PKG
+2 SET DEFAULT=$ORDER(^ORD(101.41,"AB","PSJ OR PAT OE",0))
SET PKG=$ORDER(^DIC(9.4,"C","PSJ",0))
+3 SET DITEM=$$DIALOG^ORCONVRT(PITEM)
if 'DITEM
GOTO DLG^ORCONVRT
+4 SET X=^ORD(101.41,DITEM,0)
SET X=X_"^^Q^"_$PIECE(^ORD(101.41,DEFAULT,0),U,5)_U_$SELECT('+$GET(^ORD(101,PITEM,101.01)):2,1:0)_U_PKG_"^0^0"
SET ^ORD(101.41,DITEM,0)=X
+5 if PKG
SET ^ORD(101.41,"APKG",+PKG,DITEM)=""
+6 SET X=$GET(^TMP("PSJQO",$JOB,1))
SET PSOI=$PIECE(X,U,3)
SET CNT=0
+7 IF PSOI
SET OI=$ORDER(^ORD(101.43,"ID",PSOI_";99PSP",0))
IF OI
if $$INACTIVE^ORCONVRT(OI)
GOTO OI^ORCONVRT
DO SET^ORCONVRT("ORDERABLE ITEM",OI)
+8 IF +$GET(^TMP("PSJQO",$JOB,"DD"))
DO SET^ORCONVRT("DISPENSE DRUG",^("DD"))
+9 if $LENGTH($PIECE(X,U,6))
DO SET^ORCONVRT("INSTRUCTIONS",$PIECE(X,U,6))
+10 if $PIECE(X,U,4)
DO SET^ORCONVRT("ROUTE",$PIECE(X,U,4))
+11 if $LENGTH($PIECE(X,U,5))
DO SET^ORCONVRT("SCHEDULE",$PIECE(X,U,5))
+12 IF $PIECE(X,U,8)
SET ^ORD(101.41,DITEM,3)="S PSJNOPC=1"
+13 ; comments
IF $GET(^TMP("PSJQO",$JOB,"PC",0))
Begin DoDot:1
+14 SET X=^TMP("PSJQO",$JOB,"PC",0)
SET X="^^"_X_U_DT_U
SET ^(0)=X
+15 SET ARRAY="^TMP(""PSJQO"","_$JOB_",""PC"")"
+16 DO SET^ORCONVRT("WORD PROCESSING 1",ARRAY)
End DoDot:1
+17 if $GET(CNT)
SET ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
+18 QUIT
