- 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
- 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