ORY94A ;SLC/MKB -- post-install for OR*3*94 cont;07:47 AM 7 Jun 2001
;;3.0;ORDER ENTRY/RESULTS REPORTING;**94**;Dec 17, 1997
;
EN ; -- Shell to check delayed med orders for inactive OI's
;
N ORODG,ORGRP,ORNOW,ORPOI,ORPDD,ORPIN,ORPFT,ORPST,ORPID,ORPAD,ORQDLG,OR0,ORDIALOG,ORIT,ORDRUG,ORPSOI,ORP,ORI,ORXX
S ORODG=+$O(^ORD(100.98,"B","PHARMACY",0)) D DG^ORCHANG1(ORODG,"BILD",.ORGRP)
S ORODG=+$O(^ORD(100.98,"B","O RX",0)),ORNOW=$$NOW^XLFDT
S ORPOI=+$$PTR("ORDERABLE ITEM"),ORPDD=+$$PTR("DISPENSE DRUG")
S ORPIN=+$$PTR("INSTRUCTIONS"),ORPFT=+$$PTR("FREE TEXT")
S ORPST=+$$PTR("STRENGTH"),ORPID=+$$PTR("DOSE"),ORPAD=+$$PTR("ADDITIVE")
; -- delayed orders conversion only
D QO3,BULLETIN
Q
;
QO3 ; -- Update inactive OI's in delayed orders, if possible
N ORVP,OREVT,ORIFN,OR0,OR3,ORTS,ORITM,ORPSITM,ORNEWOI
S ORVP=$G(^XTMP("OR94","PAT")) ;find where left off, if restarted
F S ORVP=$O(^OR(100,"AEVNT",ORVP)) Q:ORVP="" D
. S OREVT="" F S OREVT=$O(^OR(100,"AEVNT",ORVP,OREVT)) Q:OREVT="" D
.. S ORIFN=0 F S ORIFN=$O(^OR(100,"AEVNT",ORVP,OREVT,ORIFN)) Q:ORIFN'>0 D
... S OR0=$G(^OR(100,ORIFN,0)),OR3=$G(^(3)),ORTS=+$P(OR0,U,13)
... Q:'$D(ORGRP(+$P(OR0,U,11))) Q:$P(OR3,U,3)'=10 ;PS, still delayed
... S ORDRUG=$$VALUE^ORMPS2("DRUG"),ORI=0
... F S ORI=$O(^OR(100,ORIFN,4.5,"ID","ORDERABLE",ORI)) Q:ORI'>0 D
.... S ORITM=+$G(^OR(100,ORIFN,4.5,ORI,1)) Q:ORITM'>0
.... S ORPSITM=+$P($G(^ORD(101.43,ORITM,0)),U,2)
.... S ORNEWOI=$$EN^PSSQORD(ORPSITM,ORDRUG)
.... I ORNEWOI>0,$P(ORNEWOI,U,2)!($P(ORNEWOI,U,3)>ORNOW) S ORNEWOI=+$O(^ORD(101.43,"ID",+ORNEWOI_";99PSP",0)) I ORNEWOI D 100 Q
.... S ^XTMP("ORDER",ORVP,OREVT_";"_ORTS,ORIFN)="" ;unconverted
. S ^XTMP("OR94","PAT")=ORVP
Q
;
100 ; -- update orderable item ptr in order
N I S ^OR(100,ORIFN,4.5,ORI,1)=ORNEWOI,ORXX=1
S I=$O(^OR(100,ORIFN,.1,"B",ORITM,0)) Q:I'>0
K ^OR(100,ORIFN,.1,"B",ORITM,I)
S ^OR(100,ORIFN,.1,I,0)=ORNEWOI,^OR(100,ORIFN,.1,"B",ORNEWOI,I)=""
Q
;
PTR(X) ; -- Return ptr to prompt OR GTX X
Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
;
BULLETIN ; -- Send bulletin containing qo's we couldn't convert
N ORNOW,ORNOW90,XMSUB,XMTEXT,XMDUZ,XMY,XMZ,XMMG,I,J,K,L,X,TS,ORD0,DIFROM
S ORNOW=$$NOW^XLFDT,ORNOW90=$$FMADD^XLFDT(ORNOW,90)
S XMDUZ="PATCH OR*3*94 CONVERSION",XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
I '$G(DUZ) S I=$G(^XTMP("OR94","DUZ")) S:I XMY(I)=""
S ^TMP("ORTXT",$J,1)="The quick order conversion of patch OR*3*94 has completed."
B1 S J=1 I $O(^XTMP("ORIT",0)) D
. S ^XTMP("ORIT",0)=ORNOW90_U_ORNOW_"^CPRS/POE Inactive Orderables conversion"
. S J=J+1,^TMP("ORTXT",$J,J)=" "
. S J=J+1,^TMP("ORTXT",$J,J)="The following quick orders have inactive orderable items that were"
. S J=J+1,^TMP("ORTXT",$J,J)="unable to be automatically replaced with active ones:"
. S I=0 F S I=$O(^XTMP("ORIT",I)) Q:I'>0 D
.. S ORD0=$G(^ORD(101.41,+I,0))
.. S J=J+1,^TMP("ORTXT",$J,J)=" "_$P(ORD0,U)_" ("_$P(ORD0,U,2)_")"
B2 I $O(^XTMP("ORPSO",0)) D
. S ^XTMP("ORPSO",0)=ORNOW90_U_ORNOW_"^CPRS/POE Outpt Dose conversion"
. S J=J+1,^TMP("ORTXT",$J,J)=" "
. S J=J+1,^TMP("ORTXT",$J,J)="The following Outpatient Pharmacy quick orders have instructions that"
. S J=J+1,^TMP("ORTXT",$J,J)="were unable to be re-formatted:"
. S I=0 F S I=$O(^XTMP("ORPSO",I)) Q:I'>0 D
.. S ORD0=$G(^ORD(101.41,+I,0))
.. S J=J+1,^TMP("ORTXT",$J,J)=" "_$P(ORD0,U)_" ("_$P(ORD0,U,2)_")"
B3 I $O(^XTMP("ORDER",0)) D
. S ^XTMP("ORDER",0)=ORNOW90_U_ORNOW_"^CPRS/POE Delayed Orders conversion"
. S J=J+1,^TMP("ORTXT",$J,J)=" "
. S J=J+1,^TMP("ORTXT",$J,J)="The following patients have delayed orders with inactive orderable items"
. S J=J+1,^TMP("ORTXT",$J,J)="that were unable to be automatically replaced with active ones:"
. S I="" F S I=$O(^XTMP("ORDER",I)) Q:I="" D ;pt
.. S K="" F S K=$O(^XTMP("ORDER",I,K)) Q:K="" D ;event;TS
... S X=$P(K,";"),TS=+$P(K,";",2) I X="D" S X="Discharge"
... E S X=$S(X="A":"Admission",X="T":"Transfer",1:"")_$S(TS:" to "_$P($G(^DIC(45.7,TS,0)),U),1:"")
... S J=J+1,^TMP("ORTXT",$J,J)=" "_$P($G(^DPT(+I,0)),U)_" - "_X_":"
... S L=0 F S L=+$O(^XTMP("ORDER",I,K,L)) Q:L'>0 S J=J+1,^TMP("ORTXT",$J,J)=" "_$E($G(^OR(100,L,8,1,.1,1,0)),1,64)_"..."
S XMSUB="PATCH OR*3*94 CONVERSION COMPLETED"
S XMTEXT="^TMP(""ORTXT"","_$J_"," D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY94A 4365 printed Sep 23, 2025@20:19:25 Page 2
ORY94A ;SLC/MKB -- post-install for OR*3*94 cont;07:47 AM 7 Jun 2001
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94**;Dec 17, 1997
+2 ;
EN ; -- Shell to check delayed med orders for inactive OI's
+1 ;
+2 NEW ORODG,ORGRP,ORNOW,ORPOI,ORPDD,ORPIN,ORPFT,ORPST,ORPID,ORPAD,ORQDLG,OR0,ORDIALOG,ORIT,ORDRUG,ORPSOI,ORP,ORI,ORXX
+3 SET ORODG=+$ORDER(^ORD(100.98,"B","PHARMACY",0))
DO DG^ORCHANG1(ORODG,"BILD",.ORGRP)
+4 SET ORODG=+$ORDER(^ORD(100.98,"B","O RX",0))
SET ORNOW=$$NOW^XLFDT
+5 SET ORPOI=+$$PTR("ORDERABLE ITEM")
SET ORPDD=+$$PTR("DISPENSE DRUG")
+6 SET ORPIN=+$$PTR("INSTRUCTIONS")
SET ORPFT=+$$PTR("FREE TEXT")
+7 SET ORPST=+$$PTR("STRENGTH")
SET ORPID=+$$PTR("DOSE")
SET ORPAD=+$$PTR("ADDITIVE")
+8 ; -- delayed orders conversion only
+9 DO QO3
DO BULLETIN
+10 QUIT
+11 ;
QO3 ; -- Update inactive OI's in delayed orders, if possible
+1 NEW ORVP,OREVT,ORIFN,OR0,OR3,ORTS,ORITM,ORPSITM,ORNEWOI
+2 ;find where left off, if restarted
SET ORVP=$GET(^XTMP("OR94","PAT"))
+3 FOR
SET ORVP=$ORDER(^OR(100,"AEVNT",ORVP))
if ORVP=""
QUIT
Begin DoDot:1
+4 SET OREVT=""
FOR
SET OREVT=$ORDER(^OR(100,"AEVNT",ORVP,OREVT))
if OREVT=""
QUIT
Begin DoDot:2
+5 SET ORIFN=0
FOR
SET ORIFN=$ORDER(^OR(100,"AEVNT",ORVP,OREVT,ORIFN))
if ORIFN'>0
QUIT
Begin DoDot:3
+6 SET OR0=$GET(^OR(100,ORIFN,0))
SET OR3=$GET(^(3))
SET ORTS=+$PIECE(OR0,U,13)
+7 ;PS, still delayed
if '$DATA(ORGRP(+$PIECE(OR0,U,11)))
QUIT
if $PIECE(OR3,U,3)'=10
QUIT
+8 SET ORDRUG=$$VALUE^ORMPS2("DRUG")
SET ORI=0
+9 FOR
SET ORI=$ORDER(^OR(100,ORIFN,4.5,"ID","ORDERABLE",ORI))
if ORI'>0
QUIT
Begin DoDot:4
+10 SET ORITM=+$GET(^OR(100,ORIFN,4.5,ORI,1))
if ORITM'>0
QUIT
+11 SET ORPSITM=+$PIECE($GET(^ORD(101.43,ORITM,0)),U,2)
+12 SET ORNEWOI=$$EN^PSSQORD(ORPSITM,ORDRUG)
+13 IF ORNEWOI>0
IF $PIECE(ORNEWOI,U,2)!($PIECE(ORNEWOI,U,3)>ORNOW)
SET ORNEWOI=+$ORDER(^ORD(101.43,"ID",+ORNEWOI_";99PSP",0))
IF ORNEWOI
DO 100
QUIT
+14 ;unconverted
SET ^XTMP("ORDER",ORVP,OREVT_";"_ORTS,ORIFN)=""
End DoDot:4
End DoDot:3
End DoDot:2
+15 SET ^XTMP("OR94","PAT")=ORVP
End DoDot:1
+16 QUIT
+17 ;
100 ; -- update orderable item ptr in order
+1 NEW I
SET ^OR(100,ORIFN,4.5,ORI,1)=ORNEWOI
SET ORXX=1
+2 SET I=$ORDER(^OR(100,ORIFN,.1,"B",ORITM,0))
if I'>0
QUIT
+3 KILL ^OR(100,ORIFN,.1,"B",ORITM,I)
+4 SET ^OR(100,ORIFN,.1,I,0)=ORNEWOI
SET ^OR(100,ORIFN,.1,"B",ORNEWOI,I)=""
+5 QUIT
+6 ;
PTR(X) ; -- Return ptr to prompt OR GTX X
+1 QUIT +$ORDER(^ORD(101.41,"AB","OR GTX "_X,0))
+2 ;
BULLETIN ; -- Send bulletin containing qo's we couldn't convert
+1 NEW ORNOW,ORNOW90,XMSUB,XMTEXT,XMDUZ,XMY,XMZ,XMMG,I,J,K,L,X,TS,ORD0,DIFROM
+2 SET ORNOW=$$NOW^XLFDT
SET ORNOW90=$$FMADD^XLFDT(ORNOW,90)
+3 SET XMDUZ="PATCH OR*3*94 CONVERSION"
SET XMY(.5)=""
if $GET(DUZ)
SET XMY(DUZ)=""
+4 IF '$GET(DUZ)
SET I=$GET(^XTMP("OR94","DUZ"))
if I
SET XMY(I)=""
+5 SET ^TMP("ORTXT",$JOB,1)="The quick order conversion of patch OR*3*94 has completed."
B1 SET J=1
IF $ORDER(^XTMP("ORIT",0))
Begin DoDot:1
+1 SET ^XTMP("ORIT",0)=ORNOW90_U_ORNOW_"^CPRS/POE Inactive Orderables conversion"
+2 SET J=J+1
SET ^TMP("ORTXT",$JOB,J)=" "
+3 SET J=J+1
SET ^TMP("ORTXT",$JOB,J)="The following quick orders have inactive orderable items that were"
+4 SET J=J+1
SET ^TMP("ORTXT",$JOB,J)="unable to be automatically replaced with active ones:"
+5 SET I=0
FOR
SET I=$ORDER(^XTMP("ORIT",I))
if I'>0
QUIT
Begin DoDot:2
+6 SET ORD0=$GET(^ORD(101.41,+I,0))
+7 SET J=J+1
SET ^TMP("ORTXT",$JOB,J)=" "_$PIECE(ORD0,U)_" ("_$PIECE(ORD0,U,2)_")"
End DoDot:2
End DoDot:1
B2 IF $ORDER(^XTMP("ORPSO",0))
Begin DoDot:1
+1 SET ^XTMP("ORPSO",0)=ORNOW90_U_ORNOW_"^CPRS/POE Outpt Dose conversion"
+2 SET J=J+1
SET ^TMP("ORTXT",$JOB,J)=" "
+3 SET J=J+1
SET ^TMP("ORTXT",$JOB,J)="The following Outpatient Pharmacy quick orders have instructions that"
+4 SET J=J+1
SET ^TMP("ORTXT",$JOB,J)="were unable to be re-formatted:"
+5 SET I=0
FOR
SET I=$ORDER(^XTMP("ORPSO",I))
if I'>0
QUIT
Begin DoDot:2
+6 SET ORD0=$GET(^ORD(101.41,+I,0))
+7 SET J=J+1
SET ^TMP("ORTXT",$JOB,J)=" "_$PIECE(ORD0,U)_" ("_$PIECE(ORD0,U,2)_")"
End DoDot:2
End DoDot:1
B3 IF $ORDER(^XTMP("ORDER",0))
Begin DoDot:1
+1 SET ^XTMP("ORDER",0)=ORNOW90_U_ORNOW_"^CPRS/POE Delayed Orders conversion"
+2 SET J=J+1
SET ^TMP("ORTXT",$JOB,J)=" "
+3 SET J=J+1
SET ^TMP("ORTXT",$JOB,J)="The following patients have delayed orders with inactive orderable items"
+4 SET J=J+1
SET ^TMP("ORTXT",$JOB,J)="that were unable to be automatically replaced with active ones:"
+5 ;pt
SET I=""
FOR
SET I=$ORDER(^XTMP("ORDER",I))
if I=""
QUIT
Begin DoDot:2
+6 ;event;TS
SET K=""
FOR
SET K=$ORDER(^XTMP("ORDER",I,K))
if K=""
QUIT
Begin DoDot:3
+7 SET X=$PIECE(K,";")
SET TS=+$PIECE(K,";",2)
IF X="D"
SET X="Discharge"
+8 IF '$TEST
SET X=$SELECT(X="A":"Admission",X="T":"Transfer",1:"")_$SELECT(TS:" to "_$PIECE($GET(^DIC(45.7,TS,0)),U),1:"")
+9 SET J=J+1
SET ^TMP("ORTXT",$JOB,J)=" "_$PIECE($GET(^DPT(+I,0)),U)_" - "_X_":"
+10 SET L=0
FOR
SET L=+$ORDER(^XTMP("ORDER",I,K,L))
if L'>0
QUIT
SET J=J+1
SET ^TMP("ORTXT",$JOB,J)=" "_$EXTRACT($GET(^OR(100,L,8,1,.1,1,0)),1,64)_"..."
End DoDot:3
End DoDot:2
End DoDot:1
+11 SET XMSUB="PATCH OR*3*94 CONVERSION COMPLETED"
+12 SET XMTEXT="^TMP(""ORTXT"","_$JOB_","
DO ^XMD
+13 QUIT
