source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDXR01.m@ 1204

Last change on this file since 1204 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1ORWDXR01 ;SLC/JDL - Utilities for Order Actions;; 6/30/03 11:48
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**187,190,195,215**;Dec 17, 1997
3CANCHG(ORY,ORIFN,TXTOD) ;
4 ;If it's an pending or unsigned unreleased renewed order, can edit=True
5 S ORY=0
6 Q:'$D(^OR(100,+ORIFN,0))
7 I TXTOD D TXTCAN(.ORY) Q
8 N OUTGRP,URELSTS,USIGSTS,RNTYPE
9 N ODGRP,ODREL,ODSIG,ODTYPE,LSTACT
10 S OUTGRP=$O(^ORD(100.98,"B","O RX",0))
11 S URELSTS=$O(^ORD(100.01,"B","UNRELEASED",0))
12 S PDSTS=$O(^ORD(100.01,"B","PENDING",0))
13 S USIGSTS=2 ; unsigned order
14 S RNTYPE=2 ; renew action
15 ;Data from the order entry
16 S LSTACT=$P($G(^OR(100,+ORIFN,3)),U,7)
17 S ODGRP=$P($G(^OR(100,+ORIFN,0)),U,11)
18 S ODREL=$P($G(^OR(100,+ORIFN,3)),U,3)
19 S ODSIG=$P($G(^OR(100,+ORIFN,8,LSTACT,0)),U,4)
20 S ODTYPE=$P($G(^OR(100,+ORIFN,3)),U,11)
21 I (ODGRP=OUTGRP),(ODREL=URELSTS),(ODSIG=USIGSTS),(ODTYPE=RNTYPE) S ORY=1
22 Q
23 ;
24TXTCAN(ORY) ;
25 ;if it's an unsigned unreleased renewed text order, can change=true
26 N URELSTS,USIGSTS,RNTYPE
27 N ODREL,ODSIG,ODTYPE,LSTACT
28 S URELSTS=$O(^ORD(100.01,"B","UNRELEASED",0))
29 S USIGSTS=2 ; unsigned order
30 S RNTYPE=2 ; renew action
31 ;Data from the order entry
32 S LSTACT=$P($G(^OR(100,+ORIFN,3)),U,7)
33 S ODREL=$P($G(^OR(100,+ORIFN,8,LSTACT,0)),U,15)
34 S ODSIG=$P($G(^OR(100,+ORIFN,8,LSTACT,0)),U,4)
35 S ODTYPE=$P($G(^OR(100,+ORIFN,3)),U,11)
36 I (ODREL=URELSTS),(ODSIG=USIGSTS),(ODTYPE=RNTYPE) S ORY=1
37 Q
38 ;
39SAVCHG(ORY,ORID,PARM1,PARM2,TXTOD) ;
40 ;save new changes on the unreleased unsigned renewed order
41 Q:'$D(^OR(100,+ORID,0))
42 ;Update new start and stop date the text order
43 I TXTOD D TXTSAV(.ORY,ORID,PARM1,PARM2) Q
44 ;Update new refills and pickup for the med order
45 N REFID,PICKID,ACT,IX,TXT,REFPOS,NDQUIT
46 S (REFID,PICKID,ACT,REFPOS,NDQUIT)=0,ORY=""
47 S ACT=+$P(ORID,";",2) S:ACT'>0 ACT=1
48 S REFID=$O(^OR(100,+ORID,4.5,"ID","REFILLS",0))
49 S PICKID=$O(^OR(100,+ORID,4.5,"ID","PICKUP",0))
50 S:$D(^OR(100,+ORID,4.5,REFID,1)) ^(1)=PARM1
51 S:$D(^OR(100,+ORID,4.5,PICKID,1)) ^(1)=PARM2
52 S IX=0 F S IX=$O(^OR(100,+ORID,8,ACT,.1,IX)) Q:('IX)!(NDQUIT) D
53 . S TXT=$G(^OR(100,+ORID,8,ACT,.1,IX,0))
54 . I ($$UP^XLFSTR(TXT)["QUANTITY:"),($$UP^XLFSTR(TXT)["REFILLS:") D
55 . . S REFPOS=$F($$UP^XLFSTR(TXT),"REFILLS")-$L("REFILLS")-1
56 . . S TXT=$E(TXT,1,REFPOS)_"Refills: "_PARM1
57 . . S ^OR(100,+ORID,8,ACT,.1,IX,0)=TXT,NDQUIT=1 Q
58 D GETBYIFN^ORWORR(.ORY,+ORID)
59 Q
60 ;
61TXTSAV(ORY,ORID,PARM1,PARM2) ;
62 ; Update new start and stop date for the unsigned unreleased
63 ; renewed text order
64 N STRTID,STOPID
65 S STRTID=$O(^OR(100,+ORID,4.5,"ID","START",0))
66 S STOPID=$O(^OR(100,+ORID,4.5,"ID","STOP",0))
67 S:$D(^OR(100,+ORID,4.5,STRTID,1)) ^(1)=PARM1
68 S:$D(^OR(100,+ORID,4.5,STOPID,1)) ^(1)=PARM2
69 D GETBYIFN^ORWORR(.ORY,+ORID)
70 Q
71 ;
72ISSPLY(ORY,DLGID,QODLG) ;
73 ; ORY=1: is "PSO SUPPLY" dialog
74 S ORY=""
75 Q:'$D(^ORD(101.41,DLGID,0))
76 I 'QODLG,($P(^ORD(101.41,DLGID,0),U)="PSO SUPPLY") S ORY=1
77 I QODLG D
78 . N SPLYDG S SPLYDG=$O(^ORD(100.98,"B","SPLY",0))
79 . I $P(^ORD(101.41,DLGID,0),U,5)=SPLYDG S ORY=1
80 Q
81 ;
82OXDATA(ORY,ORIEN) ; Return orderable item data for order check usage
83 Q:'$D(^OR(100,+ORIEN,0))
84 N DRUGID,OIID,IDX,IDY,DISPIN,DISPOUT,DISPID
85 S (DRUGID,OIID,IDX,IDY,DISPIN,DISPOUT)=0
86 S DISPID=""
87 S DISPIN=$O(^ORD(100.98,"B","UD RX",0))
88 S DISPOUT=$O(^ORD(100.98,"B","O RX",0))
89 N DISPCM S DISPCM=$O(^ORD(100.98,"B","CLINIC ORDERS",0))
90 S DRUGID=$O(^OR(100,+ORIEN,4.5,"ID","DRUG",0))
91 S OIID=$O(^OR(100,+ORIEN,4.5,"ID","ORDERABLE",0))
92 S DISPID=$P(^OR(100,+ORIEN,0),U,11)
93 I DISPID=DISPIN S DISPID="PSI"
94 I DISPID=DISPOUT S DISPID="PSO"
95 I DISPID=DISPCM S DISPID="PSI"
96 I (DISPID'="PSI"),(DISPID'="PSO") Q
97 Q:'DRUGID
98 Q:'OIID
99 S IDX=$O(^OR(100,+ORIEN,4.5,DRUGID,0))
100 S IDY=$O(^OR(100,+ORIEN,4.5,OIID,0))
101 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))
102 Q
Note: See TracBrowser for help on using the repository browser.