Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWDXR01

ORWDXR01.m

Go to the documentation of this file. 
  1. 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
  1. CANCHG(ORY,ORIFN,TXTOD) ;
  1.  ;If it's an pending or unsigned unreleased renewed order, can edit=True
  1.  S ORY=0
  1.  Q:'$D(^OR(100,+ORIFN,0))
  1.  I TXTOD D TXTCAN(.ORY) Q
  1.  N OUTGRP,URELSTS,USIGSTS,RNTYPE
  1.  N ODGRP,ODREL,ODSIG,ODTYPE,LSTACT
  1.  S OUTGRP=$O(^ORD(100.98,"B","O RX",0))
  1.  S URELSTS=$O(^ORD(100.01,"B","UNRELEASED",0))
  1.  S PDSTS=$O(^ORD(100.01,"B","PENDING",0))
  1.  S USIGSTS=2 ; unsigned order
  1.  S RNTYPE=2 ; renew action
  1.  ;Data from the order entry
  1.  S LSTACT=$P($G(^OR(100,+ORIFN,3)),U,7)
  1.  S ODGRP=$P($G(^OR(100,+ORIFN,0)),U,11)
  1.  S ODREL=$P($G(^OR(100,+ORIFN,3)),U,3)
  1.  S ODSIG=$P($G(^OR(100,+ORIFN,8,LSTACT,0)),U,4)
  1.  S ODTYPE=$P($G(^OR(100,+ORIFN,3)),U,11)
  1.  I (ODGRP=OUTGRP),(ODREL=URELSTS),(ODSIG=USIGSTS),(ODTYPE=RNTYPE) S ORY=1
  1.  Q
  1.  ;
  1. TXTCAN(ORY) ;
  1.  ;if it's an unsigned unreleased renewed text order, can change=true
  1.  N URELSTS,USIGSTS,RNTYPE
  1.  N ODREL,ODSIG,ODTYPE,LSTACT
  1.  S URELSTS=$O(^ORD(100.01,"B","UNRELEASED",0))
  1.  S USIGSTS=2 ; unsigned order
  1.  S RNTYPE=2 ; renew action
  1.  ;Data from the order entry
  1.  S LSTACT=$P($G(^OR(100,+ORIFN,3)),U,7)
  1.  S ODREL=$P($G(^OR(100,+ORIFN,8,LSTACT,0)),U,15)
  1.  S ODSIG=$P($G(^OR(100,+ORIFN,8,LSTACT,0)),U,4)
  1.  S ODTYPE=$P($G(^OR(100,+ORIFN,3)),U,11)
  1.  I (ODREL=URELSTS),(ODSIG=USIGSTS),(ODTYPE=RNTYPE) S ORY=1
  1.  Q
  1.  ;
  1. SAVCHG(ORY,ORID,PARM1,PARM2,TXTOD) ;
  1.  ;save new changes on the unreleased unsigned renewed order
  1.  Q:'$D(^OR(100,+ORID,0))
  1.  ;Update new start and stop date the text order
  1.  I TXTOD D TXTSAV(.ORY,ORID,PARM1,PARM2) Q
  1.  ;Update new refills and pickup for the med order
  1.  N REFID,PICKID,ACT,IX,TXT,REFPOS,NDQUIT
  1.  S (REFID,PICKID,ACT,REFPOS,NDQUIT)=0,ORY=""
  1.  S ACT=+$P(ORID,";",2) S:ACT'>0 ACT=1
  1.  S REFID=$O(^OR(100,+ORID,4.5,"ID","REFILLS",0))
  1.  S PICKID=$O(^OR(100,+ORID,4.5,"ID","PICKUP",0))
  1.  S:$D(^OR(100,+ORID,4.5,REFID,1)) ^(1)=PARM1
  1.  S:$D(^OR(100,+ORID,4.5,PICKID,1)) ^(1)=PARM2
  1.  S IX=0 F  S IX=$O(^OR(100,+ORID,8,ACT,.1,IX)) Q:('IX)!(NDQUIT)  D
  1.  . S TXT=$G(^OR(100,+ORID,8,ACT,.1,IX,0))
  1.  . I ($$UP^XLFSTR(TXT)["QUANTITY:"),($$UP^XLFSTR(TXT)["REFILLS:") D
  1.  . . S REFPOS=$F($$UP^XLFSTR(TXT),"REFILLS")-$L("REFILLS")-1
  1.  . . S TXT=$E(TXT,1,REFPOS)_"Refills: "_PARM1
  1.  . . S ^OR(100,+ORID,8,ACT,.1,IX,0)=TXT,NDQUIT=1 Q
  1.  D GETBYIFN^ORWORR(.ORY,+ORID)
  1.  Q
  1.  ;
  1. TXTSAV(ORY,ORID,PARM1,PARM2) ;
  1.  ; Update new start and stop date for the unsigned unreleased 
  1.  ; renewed text order
  1.  N STRTID,STOPID
  1.  S STRTID=$O(^OR(100,+ORID,4.5,"ID","START",0))
  1.  S STOPID=$O(^OR(100,+ORID,4.5,"ID","STOP",0))
  1.  S:$D(^OR(100,+ORID,4.5,STRTID,1)) ^(1)=PARM1
  1.  S:$D(^OR(100,+ORID,4.5,STOPID,1)) ^(1)=PARM2
  1.  D GETBYIFN^ORWORR(.ORY,+ORID)
  1.  Q
  1.  ;
  1. ISSPLY(ORY,DLGID,QODLG) ;
  1.  ; ORY=1: is "PSO SUPPLY" dialog
  1.  S ORY=""
  1.  Q:'$D(^ORD(101.41,DLGID,0))
  1.  I 'QODLG,($P(^ORD(101.41,DLGID,0),U)="PSO SUPPLY") S ORY=1
  1.  I QODLG D
  1.  . N SPLYDG S SPLYDG=$O(^ORD(100.98,"B","SPLY",0))
  1.  . I $P(^ORD(101.41,DLGID,0),U,5)=SPLYDG S ORY=1
  1.  Q
  1.  ;
  1. OXDATA(ORY,ORIEN) ; Return orderable item data for order check usage
  1.  Q:'$D(^OR(100,+ORIEN,0))
  1.  N DRUGID,OIID,IDX,IDY,DISPIN,DISPOUT,DISPID
  1.  S (DRUGID,OIID,IDX,IDY,DISPIN,DISPOUT)=0
  1.  S DISPID=""
  1.  S DISPIN=$O(^ORD(100.98,"B","UD RX",0))
  1.  S DISPOUT=$O(^ORD(100.98,"B","O RX",0))
  1.  N DISPCM S DISPCM=$O(^ORD(100.98,"B","CLINIC ORDERS",0))
  1.  S DRUGID=$O(^OR(100,+ORIEN,4.5,"ID","DRUG",0))
  1.  S OIID=$O(^OR(100,+ORIEN,4.5,"ID","ORDERABLE",0))
  1.  S DISPID=$P(^OR(100,+ORIEN,0),U,11)
  1.  I DISPID=DISPIN S DISPID="PSI"
  1.  I DISPID=DISPOUT S DISPID="PSO"
  1.  I DISPID=DISPCM S DISPID="PSI"
  1.  I (DISPID'="PSI"),(DISPID'="PSO") Q
  1.  Q:'DRUGID
  1.  Q:'OIID
  1.  S IDX=$O(^OR(100,+ORIEN,4.5,DRUGID,0))
  1.  S IDY=$O(^OR(100,+ORIEN,4.5,OIID,0))
  1.  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))
  1.  Q