source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWPFSS1.m@ 1101

Last change on this file since 1101 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1ORWPFSS1 ;SLC/GSS - CPRS PFSS; 05/24/05 [05/24/05 11:44am]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**228**;Dec 17, 1997
3 ; Sub-routines for phase II of the CPRS PFSS project (CPRS v26=phase I)
4 ;
5 Q
6 ;
7ACCTREF(ORIEN,ORACTREF) ;File PFSS Account Reference Number (ARN)
8 ; PFSS ARN stored as 1st piece of ^OR(100,ORIEN,5.5), aka Field #97
9 ; Call as an extrinsic function,i.e., $$ACCTREF^ORWPFSS1(ORIEN,ORACTREF)
10 ;
11 ; Input:
12 ; ORIEN Order internal reference number related to PFSS ARN
13 ; ORACTREF PFSS ARN to store, which is a pointer to File #375
14 ; Output:
15 ; if error, returns #^reason, where #>1
16 ; if valid, returns 1
17 ;
18 ; Additional variables used:
19 ; ORERCK error variable (error #^verbiage)
20 ;
21 ; new variables
22 N ARE,ORER,ORERCK,ORFDA,ORNEWER
23 ;
24 ; check for a valid ORIEN
25 S ORERCK=$$ORDERCK^ORWPFSS(ORIEN)
26 I +ORERCK>1 Q ORERCK
27 ;
28 ; check for pre-existing, non-null entry, if there is to be no editing
29 I $G(^OR(100,ORIEN,5.5))'="" Q 97_U_"PFSS Acct Ref # exists in Order file"
30 ; check that PFSS ARN is in a valid format
31 I '+ORACTREF Q 98_U_"PFSS is null or of invalid format"
32 ; check that PFSS ARN exists in PFSS Acount file #375 - DBIA #4741
33 I '$D(^IBBAA(375,ORACTREF,0)) Q 99_U_"PFSS Acct Ref # doesn't exist"
34 ;
35 ; store PARN (while checking for errors)
36 S ORERCK=$$STRPARN(ORIEN,ORACTREF)
37 Q ORERCK
38 ;
39EDO1 ; Event Delayed Orders called from EN1^ORCSEND for delayed releases
40 ;
41 ; EIEN = Release event IEN
42 ; EPOINTER = Event pointer
43 ; ETYPE = Event type
44 ; DFN = Patient IEN
45 ; ORACTREF = PFSS Account Reference Number
46 ; ORERCK = Order check results (1 = OK)
47 ; ORIFN = Order IEN (previously defined)
48 ;
49 ; new variables used
50 N EIEN,EPOINTER,ETYPE,DFN,ORACTREF,ORERCK,ORPFSS
51 ;
52 ; quit if PFSS is not active
53 D PFSSACTV^ORWPFSS(.ORPFSS) I ORPFSS=0 G EDO1Q
54 ;
55 ; check validity/support of order
56 S ORERCK=$$ORDERCK^ORWPFSS(ORIFN) I +ORERCK>1 G EDO1Q
57 ;
58 ; get Event Pointer
59 S EPOINTER=$P(^OR(100,ORIFN,0),U,17)
60 ; if EPOINTER is null then quit
61 I EPOINTER="" G EDO1Q
62 ;
63 ; get Release Event Record
64 S EIEN=$P(^ORE(100.2,EPOINTER,0),U,2)
65 ; if EIEN is null then quit
66 I EIEN="" G EDO1Q
67 ;
68 ; get Event Type
69 S ETYPE=$P(^ORD(100.5,EIEN,0),U,2)
70 ;
71 ; if ETYPE is Admission or Transfer get PFSS ARN from VADPT
72 I ETYPE="A"!(ETYPE="T") D
73 . ; set patient IEN (DFN)
74 . S DFN=$P($P(^OR(100,ORIFN,0),";"),U,2)
75 . ; call VADPT (hospital adm/txfr) routine to get PFSS ARN (ORACTREF)
76 . S ORACTREF=$$HAAR^ORWPFSS4(DFN)
77 . ; store PFSS ARN in Order file (#100)
78 . S X=$$STRPARN(ORIFN,ORACTREF)
79 ;
80 ; if ETYPE is Discharge store PFSS ARN as null in Order file (#100)
81 I ETYPE="D" S X=$$STRPARN(ORIFN,"")
82 ;
83 ; ???-course of action if errors or EPOINTER or EIEN null?
84EDO1Q Q
85 ;
86EDO2 ; Event Delayed Orders called from EN2^ORCSEND for manual releases
87 ; Get the PARN in effecxt when the event delayed order (EDO) released.
88 ;
89 ; Variables used:
90 ; EIEN = Release event IEN
91 ; EPOINTER = Event pointer
92 ; DFN = Patient IEN
93 ; ORACTREF = PFSS Account Reference Number
94 ; ORERCK = Order check results (1 = OK)
95 ; ORIFN = Order IEN (previously defined)
96 ;
97 ; new variables used
98 N EIEN,EPOINTER,ETYPE,DFN,ORACTREF,ORERCK,ORPFSS
99 ;
100 ; quit if PFSS is not active
101 D PFSSACTV^ORWPFSS(.ORPFSS) I ORPFSS=0 G EDO2Q
102 ;
103 ; check validity/support of order
104 S ORERCK=$$ORDERCK^ORWPFSS(ORIFN) I +ORERCK>1 G EDO2Q
105 ;
106 ; get Event Pointer
107 S EPOINTER=$P(^OR(100,ORIFN,0),U,17)
108 ; if EPOINTER is null then quit
109 I EPOINTER="" G EDO2Q
110 ;
111 ; get Release Event Record
112 S EIEN=$P(^ORE(100.2,EPOINTER,0),U,2)
113 ; if EIEN is null then quit
114 I EIEN="" G EDO2Q
115 ;
116 ; set patient IEN (DFN)
117 S DFN=$P($P(^OR(100,ORIFN,0),";"),U,2)
118 ; call VADPT (hospital adm/txfr) routine to get PFSS ARN (ORACTREF)
119 S ORACTREF=$$HAAR^ORWPFSS4(DFN)
120 ; store PFSS ARN in Order file (#100)
121 S X=$$STRPARN(ORIFN,ORACTREF)
122 ;
123 ; ???-course of action if errors or EPOINTER or EIEN null?
124EDO2Q Q
125 ;
126STRPARN(ORIEN,ORACTREF) ; store of PFSS ARN
127 ; stores PFSS Account Reference Number in the Order file #100, field 97
128 ; see ACCTREF for passed in variable descriptions
129 ;
130 ; Variables used:
131 ; ORER = Error message
132 ; ORFIELD = PFSS ARN field (#97)
133 ; ORFILE = ORDER file (#100)
134 ; ORFLAGS = null (flags used in controlling use of FDA^DIFL)
135 ;
136 ; new variables
137 N ORER,ORFILE,ORFIELD,ORFLAGS
138 ;
139 ; set contants
140 S ORFILE=100,ORFIELD=97,ORFLAGS=""
141 ;
142 ; do FDA loader to compose FDA_ROOT
143 D FDA^DILF(ORFILE,ORIEN,ORFIELD,ORFLAGS,ORACTREF,"ORFDA","ORER")
144 ; check for an error
145 D ERRCHK I $D(ORNEWER) Q ORER
146 ; file PFSS ARN in Order file
147 D UPDATE^DIE("","ORFDA","","ORER")
148 ; another error check
149 D ERRCHK I $D(ORNEWER) Q ORER
150 ; successful data
151 Q 1
152 ;
153ERRCHK ; Compose error message if there's an error from use of DILF or DIE
154 I $G(ORER("DIERR",1)) D
155 . S ORNEWER=$G(ORER("DIERR",1))_U_$G(ORER("DIERR",1,"TEXT",1))
156 Q
Note: See TracBrowser for help on using the repository browser.