ORWDXR01 ;SLC/JDL - Utilities for Order Actions;; 6/30/03 11:48
;;3.0;ORDER ENTRY/RESULTS REPORTING;**187,190,195,215**;Dec 17, 1997
CANCHG(ORY,ORIFN,TXTOD) ;
;If it's an pending or unsigned unreleased renewed order, can edit=True
S ORY=0
Q:'$D(^OR(100,+ORIFN,0))
I TXTOD D TXTCAN(.ORY) Q
N OUTGRP,URELSTS,USIGSTS,RNTYPE
N ODGRP,ODREL,ODSIG,ODTYPE,LSTACT
S OUTGRP=$O(^ORD(100.98,"B","O RX",0))
S URELSTS=$O(^ORD(100.01,"B","UNRELEASED",0))
S PDSTS=$O(^ORD(100.01,"B","PENDING",0))
S USIGSTS=2 ; unsigned order
S RNTYPE=2 ; renew action
;Data from the order entry
S LSTACT=$P($G(^OR(100,+ORIFN,3)),U,7)
S ODGRP=$P($G(^OR(100,+ORIFN,0)),U,11)
S ODREL=$P($G(^OR(100,+ORIFN,3)),U,3)
S ODSIG=$P($G(^OR(100,+ORIFN,8,LSTACT,0)),U,4)
S ODTYPE=$P($G(^OR(100,+ORIFN,3)),U,11)
I (ODGRP=OUTGRP),(ODREL=URELSTS),(ODSIG=USIGSTS),(ODTYPE=RNTYPE) S ORY=1
Q
;
TXTCAN(ORY) ;
;if it's an unsigned unreleased renewed text order, can change=true
N URELSTS,USIGSTS,RNTYPE
N ODREL,ODSIG,ODTYPE,LSTACT
S URELSTS=$O(^ORD(100.01,"B","UNRELEASED",0))
S USIGSTS=2 ; unsigned order
S RNTYPE=2 ; renew action
;Data from the order entry
S LSTACT=$P($G(^OR(100,+ORIFN,3)),U,7)
S ODREL=$P($G(^OR(100,+ORIFN,8,LSTACT,0)),U,15)
S ODSIG=$P($G(^OR(100,+ORIFN,8,LSTACT,0)),U,4)
S ODTYPE=$P($G(^OR(100,+ORIFN,3)),U,11)
I (ODREL=URELSTS),(ODSIG=USIGSTS),(ODTYPE=RNTYPE) S ORY=1
Q
;
SAVCHG(ORY,ORID,PARM1,PARM2,TXTOD) ;
;save new changes on the unreleased unsigned renewed order
Q:'$D(^OR(100,+ORID,0))
;Update new start and stop date the text order
I TXTOD D TXTSAV(.ORY,ORID,PARM1,PARM2) Q
;Update new refills and pickup for the med order
N REFID,PICKID,ACT,IX,TXT,REFPOS,NDQUIT
S (REFID,PICKID,ACT,REFPOS,NDQUIT)=0,ORY=""
S ACT=+$P(ORID,";",2) S:ACT'>0 ACT=1
S REFID=$O(^OR(100,+ORID,4.5,"ID","REFILLS",0))
S PICKID=$O(^OR(100,+ORID,4.5,"ID","PICKUP",0))
S:$D(^OR(100,+ORID,4.5,REFID,1)) ^(1)=PARM1
S:$D(^OR(100,+ORID,4.5,PICKID,1)) ^(1)=PARM2
S IX=0 F S IX=$O(^OR(100,+ORID,8,ACT,.1,IX)) Q:('IX)!(NDQUIT) D
. S TXT=$G(^OR(100,+ORID,8,ACT,.1,IX,0))
. I ($$UP^XLFSTR(TXT)["QUANTITY:"),($$UP^XLFSTR(TXT)["REFILLS:") D
. . S REFPOS=$F($$UP^XLFSTR(TXT),"REFILLS")-$L("REFILLS")-1
. . S TXT=$E(TXT,1,REFPOS)_"Refills: "_PARM1
. . S ^OR(100,+ORID,8,ACT,.1,IX,0)=TXT,NDQUIT=1 Q
D GETBYIFN^ORWORR(.ORY,+ORID)
Q
;
TXTSAV(ORY,ORID,PARM1,PARM2) ;
; Update new start and stop date for the unsigned unreleased
; renewed text order
N STRTID,STOPID
S STRTID=$O(^OR(100,+ORID,4.5,"ID","START",0))
S STOPID=$O(^OR(100,+ORID,4.5,"ID","STOP",0))
S:$D(^OR(100,+ORID,4.5,STRTID,1)) ^(1)=PARM1
S:$D(^OR(100,+ORID,4.5,STOPID,1)) ^(1)=PARM2
D GETBYIFN^ORWORR(.ORY,+ORID)
Q
;
ISSPLY(ORY,DLGID,QODLG) ;
; ORY=1: is "PSO SUPPLY" dialog
S ORY=""
Q:'$D(^ORD(101.41,DLGID,0))
I 'QODLG,($P(^ORD(101.41,DLGID,0),U)="PSO SUPPLY") S ORY=1
I QODLG D
. N SPLYDG S SPLYDG=$O(^ORD(100.98,"B","SPLY",0))
. I $P(^ORD(101.41,DLGID,0),U,5)=SPLYDG S ORY=1
Q
;
OXDATA(ORY,ORIEN) ; Return orderable item data for order check usage
Q:'$D(^OR(100,+ORIEN,0))
N DRUGID,OIID,IDX,IDY,DISPIN,DISPOUT,DISPID
S (DRUGID,OIID,IDX,IDY,DISPIN,DISPOUT)=0
S DISPID=""
S DISPIN=$O(^ORD(100.98,"B","UD RX",0))
S DISPOUT=$O(^ORD(100.98,"B","O RX",0))
N DISPCM S DISPCM=$O(^ORD(100.98,"B","CLINIC ORDERS",0))
S DRUGID=$O(^OR(100,+ORIEN,4.5,"ID","DRUG",0))
S OIID=$O(^OR(100,+ORIEN,4.5,"ID","ORDERABLE",0))
S DISPID=$P(^OR(100,+ORIEN,0),U,11)
I DISPID=DISPIN S DISPID="PSI"
I DISPID=DISPOUT S DISPID="PSO"
I DISPID=DISPCM S DISPID="PSI"
I (DISPID'="PSI"),(DISPID'="PSO") Q
Q:'DRUGID
Q:'OIID
S IDX=$O(^OR(100,+ORIEN,4.5,DRUGID,0))
S IDY=$O(^OR(100,+ORIEN,4.5,OIID,0))
I IDX,IDY,'+DISPID S ORY=$G(^OR(100,+ORIEN,4.5,OIID,IDY))_U_DISPID_U_$G(^OR(100,+ORIEN,4.5,DRUGID,IDX))
Q
ORWDXR01 ;SLC/JDL - Utilities for Order Actions;; 6/30/03 11:48
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**187,190,195,215**;Dec 17, 1997
CANCHG(ORY,ORIFN,TXTOD) ;
+1 ;If it's an pending or unsigned unreleased renewed order, can edit=True
+2 SET ORY=0
+3 IF '$DATA(^OR(100,+ORIFN,0))
QUIT
+4 IF TXTOD
DO TXTCAN(.ORY)
QUIT
+5 NEW OUTGRP,URELSTS,USIGSTS,RNTYPE
+6 NEW ODGRP,ODREL,ODSIG,ODTYPE,LSTACT
+7 SET OUTGRP=$ORDER(^ORD(100.98,"B","O RX",0))
+8 SET URELSTS=$ORDER(^ORD(100.01,"B","UNRELEASED",0))
+9 SET PDSTS=$ORDER(^ORD(100.01,"B","PENDING",0))
+10 ; unsigned order
SET USIGSTS=2
+11 ; renew action
SET RNTYPE=2
+12 ;Data from the order entry
+13 SET LSTACT=$PIECE($GET(^OR(100,+ORIFN,3)),U,7)
+14 SET ODGRP=$PIECE($GET(^OR(100,+ORIFN,0)),U,11)
+15 SET ODREL=$PIECE($GET(^OR(100,+ORIFN,3)),U,3)
+16 SET ODSIG=$PIECE($GET(^OR(100,+ORIFN,8,LSTACT,0)),U,4)
+17 SET ODTYPE=$PIECE($GET(^OR(100,+ORIFN,3)),U,11)
+18 IF (ODGRP=OUTGRP)
IF (ODREL=URELSTS)
IF (ODSIG=USIGSTS)
IF (ODTYPE=RNTYPE)
SET ORY=1
+19 QUIT
+20 ;
TXTCAN(ORY) ;
+1 ;if it's an unsigned unreleased renewed text order, can change=true
+2 NEW URELSTS,USIGSTS,RNTYPE
+3 NEW ODREL,ODSIG,ODTYPE,LSTACT
+4 SET URELSTS=$ORDER(^ORD(100.01,"B","UNRELEASED",0))
+5 ; unsigned order
SET USIGSTS=2
+6 ; renew action
SET RNTYPE=2
+7 ;Data from the order entry
+8 SET LSTACT=$PIECE($GET(^OR(100,+ORIFN,3)),U,7)
+9 SET ODREL=$PIECE($GET(^OR(100,+ORIFN,8,LSTACT,0)),U,15)
+10 SET ODSIG=$PIECE($GET(^OR(100,+ORIFN,8,LSTACT,0)),U,4)
+11 SET ODTYPE=$PIECE($GET(^OR(100,+ORIFN,3)),U,11)
+12 IF (ODREL=URELSTS)
IF (ODSIG=USIGSTS)
IF (ODTYPE=RNTYPE)
SET ORY=1
+13 QUIT
+14 ;
SAVCHG(ORY,ORID,PARM1,PARM2,TXTOD) ;
+1 ;save new changes on the unreleased unsigned renewed order
+2 IF '$DATA(^OR(100,+ORID,0))
QUIT
+3 ;Update new start and stop date the text order
+4 IF TXTOD
DO TXTSAV(.ORY,ORID,PARM1,PARM2)
QUIT
+5 ;Update new refills and pickup for the med order
+6 NEW REFID,PICKID,ACT,IX,TXT,REFPOS,NDQUIT
+7 SET (REFID,PICKID,ACT,REFPOS,NDQUIT)=0
SET ORY=""
+8 SET ACT=+$PIECE(ORID,";",2)
IF ACT'>0
SET ACT=1
+9 SET REFID=$ORDER(^OR(100,+ORID,4.5,"ID","REFILLS",0))
+10 SET PICKID=$ORDER(^OR(100,+ORID,4.5,"ID","PICKUP",0))
+11 IF $DATA(^OR(100,+ORID,4.5,REFID,1))
SET ^(1)=PARM1
+12 IF $DATA(^OR(100,+ORID,4.5,PICKID,1))
SET ^(1)=PARM2
+13 SET IX=0
FOR
SET IX=$ORDER(^OR(100,+ORID,8,ACT,.1,IX))
IF ('IX)!(NDQUIT)
QUIT
Begin DoDot:1
+14 SET TXT=$GET(^OR(100,+ORID,8,ACT,.1,IX,0))
+15 IF ($$UP^XLFSTR(TXT)["QUANTITY:")
IF ($$UP^XLFSTR(TXT)["REFILLS:")
Begin DoDot:2
+16 SET REFPOS=$FIND($$UP^XLFSTR(TXT),"REFILLS")-$LENGTH("REFILLS")-1
+17 SET TXT=$EXTRACT(TXT,1,REFPOS)_"Refills: "_PARM1
+18 SET ^OR(100,+ORID,8,ACT,.1,IX,0)=TXT
SET NDQUIT=1
QUIT
End DoDot:2
End DoDot:1
+19 DO GETBYIFN^ORWORR(.ORY,+ORID)
+20 QUIT
+21 ;
TXTSAV(ORY,ORID,PARM1,PARM2) ;
+1 ; Update new start and stop date for the unsigned unreleased
+2 ; renewed text order
+3 NEW STRTID,STOPID
+4 SET STRTID=$ORDER(^OR(100,+ORID,4.5,"ID","START",0))
+5 SET STOPID=$ORDER(^OR(100,+ORID,4.5,"ID","STOP",0))
+6 IF $DATA(^OR(100,+ORID,4.5,STRTID,1))
SET ^(1)=PARM1
+7 IF $DATA(^OR(100,+ORID,4.5,STOPID,1))
SET ^(1)=PARM2
+8 DO GETBYIFN^ORWORR(.ORY,+ORID)
+9 QUIT
+10 ;
ISSPLY(ORY,DLGID,QODLG) ;
+1 ; ORY=1: is "PSO SUPPLY" dialog
+2 SET ORY=""
+3 IF '$DATA(^ORD(101.41,DLGID,0))
QUIT
+4 IF 'QODLG
IF ($PIECE(^ORD(101.41,DLGID,0),U)="PSO SUPPLY")
SET ORY=1
+5 IF QODLG
Begin DoDot:1
+6 NEW SPLYDG
SET SPLYDG=$ORDER(^ORD(100.98,"B","SPLY",0))
+7 IF $PIECE(^ORD(101.41,DLGID,0),U,5)=SPLYDG
SET ORY=1
End DoDot:1
+8 QUIT
+9 ;
OXDATA(ORY,ORIEN) ; Return orderable item data for order check usage
+1 IF '$DATA(^OR(100,+ORIEN,0))
QUIT
+2 NEW DRUGID,OIID,IDX,IDY,DISPIN,DISPOUT,DISPID
+3 SET (DRUGID,OIID,IDX,IDY,DISPIN,DISPOUT)=0
+4 SET DISPID=""
+5 SET DISPIN=$ORDER(^ORD(100.98,"B","UD RX",0))
+6 SET DISPOUT=$ORDER(^ORD(100.98,"B","O RX",0))
+7 NEW DISPCM
SET DISPCM=$ORDER(^ORD(100.98,"B","CLINIC ORDERS",0))
+8 SET DRUGID=$ORDER(^OR(100,+ORIEN,4.5,"ID","DRUG",0))
+9 SET OIID=$ORDER(^OR(100,+ORIEN,4.5,"ID","ORDERABLE",0))
+10 SET DISPID=$PIECE(^OR(100,+ORIEN,0),U,11)
+11 IF DISPID=DISPIN
SET DISPID="PSI"
+12 IF DISPID=DISPOUT
SET DISPID="PSO"
+13 IF DISPID=DISPCM
SET DISPID="PSI"
+14 IF (DISPID'="PSI")
IF (DISPID'="PSO")
QUIT
+15 IF 'DRUGID
QUIT
+16 IF 'OIID
QUIT
+17 SET IDX=$ORDER(^OR(100,+ORIEN,4.5,DRUGID,0))
+18 SET IDY=$ORDER(^OR(100,+ORIEN,4.5,OIID,0))
+19 IF IDX
IF IDY
IF '+DISPID
SET ORY=$GET(^OR(100,+ORIEN,4.5,OIID,IDY))_U_DISPID_U_$GET(^OR(100,+ORIEN,4.5,DRUGID,IDX))
+20 QUIT
