source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORQQPL2.m@ 1036

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

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1ORQQPL2 ; ALB/PDR/REV - RPCs FOR CPRS GUI IMPLEMENTATION ;09:49 AM 29 Feb 2000
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10**;Dec 17, 1997
3 ;
4 ; -------------- GET HISTORY FOR DETAIL DISPLAY ----------------------
5 ;
6HIST(RETURN,GMPIFN) ; GET AUDIT HISTORY
7 ; taken from EN^GMPLDISP
8 N IDT,AIFN,S,ORDT,TXT,I,L,GMPDT,LCNT
9 S LCNT=0
10 I '$D(^GMPL(125.8,"B",GMPIFN)) D Q ;BAIL OUT - NO CHANGES
11 . S RETURN(0)="NONE"
12 ; get change history
13 S IDT=""
14 F S IDT=$O(^GMPL(125.8,"AD",GMPIFN,IDT)) Q:IDT'>0 D
15 . S AIFN=""
16 . F S AIFN=$O(^GMPL(125.8,"AD",GMPIFN,IDT,AIFN)) Q:AIFN'>0 D
17 .. D DT^GMPLHIST
18 ; Transfer data and clean up for return to GUI
19 S S="",I=0,TXT=""
20 F S S=$O(GMPDT(S)) Q:S="" D
21 . S L=GMPDT(S,0)
22 . I $L(L,": ")>1 D Q ; does line begin with date? (hope ": " can't be part of text)
23 .. D FLUSH(.RETURN,.I)
24 .. S ORDT=$P(L,": ") ; get new date
25 .. S TXT=$$STRIP($P(L,": ",2,999)) ; start new text string
26 . S TXT=TXT_" "_$$STRIP(L) ; line does not begin with date, so add to existing text line
27 I '$D(RETURN(0)) S RETURN(0)=I
28 D FLUSH(.RETURN,.I)
29 Q
30 ;
31FLUSH(RETURN,I) ; FLUSH FORMATTED AUDIT STRING
32 I I'=0 D ; do we have a text string built?
33 . S RETURN(I)=$$STRIP(ORDT)_U_TXT ; return date and text
34 S I=I+1
35 Q
36 ;
37STRIP(VAL) ; STRIP LEADING SPACES FROM VALUES
38 N J
39 F J=1:1 Q:$E(VAL,J)'=" "
40 Q $E(VAL,J,9999)
41 ;
42 ; ------------------- DELETE A PROBLEM FROM LIST ---------------------
43 ;
44DELETE(RESULT,GMPIFN,GMPROV,GMPVAMC,REASON) ; DELETE A PROBLEM
45 ; From GMPL1 - silent version
46 N CHNGE
47 I REASON'="" D
48 . S GMPFLD(10,"NEW",1)=REASON
49 . D NEWNOTE^GMPLSAVE
50 S CHNGE=GMPIFN_"^1.02^"_$$HTFM^XLFDT($H)
51 S CHNGE=CHNGE_U_DUZ_"^P^H^Deleted^"_+$G(GMPROV)
52 S $P(^AUPNPROB(GMPIFN,1),U,2)="H"
53 S RESULT=1
54 D AUDIT^GMPLX(CHNGE,"")
55 D DTMOD^GMPLX(GMPIFN)
56 K GMPFLD
57 Q
58 ; ------------------ REPLACE REMOVED PROBLEM ----------------------
59 ;
60REPLACE(RETURN,DA) ; -- replace problem on patient's list
61 ; taken from REPLACE^GMPLRPTR
62 N CHNGE,DIE,DR
63 I $P($G(^AUPNPROB(DA,1)),U,2)'="H" D Q ; BAIL OUT - INVALID RECORD
64 . S RETURN=0
65 S DR="1.02////P"
66 S DIE="^AUPNPROB("
67 D ^DIE
68 S CHNGE=DA_"^1.02^"_$$HTFM^XLFDT($H)_U_DUZ_"^H^P^Replaced^"_DUZ
69 D AUDIT^GMPLX(CHNGE,"")
70 D DTMOD^GMPLX(DA)
71 S RETURN=1
72 Q
73 ;
74 ; ------------------- VERIFY A PROBLEM ------------------------
75 ;
76VERIFY(RETURN,GMPIFN) ; -- verify a transcribed problem
77 ; RETURN: ;(consistent with UPDATE function)
78 ; SUCCESS:
79 ; RETURN>0, RETURN(0)=""
80 ; FAILURE:
81 ; RETURN<0, RETURN(0)=verbose error message
82 N NOW,CHNGE
83 S NOW=$$HTFM^XLFDT($H)
84 I $P(^AUPNPROB(GMPIFN,1),U,2)'="T" D Q ; BAIL OUT - ALREADY VERIFIED
85 . S RETURN=-1
86 . S RETURN(0)="Problem Already Verified"
87 L +^AUPNPROB(GMPIFN,0):10
88 I '$T D Q ; BAIL OUT - NO LOCK
89 . S RETURN=-1
90 . S RETURN(0)="Record in use. Try again in a few moments"
91 S $P(^AUPNPROB(GMPIFN,1),U,2)="P"
92 S CHNGE=GMPIFN_"^1.02^"_NOW_U_DUZ_"^T^P^Verified^"_DUZ
93 D AUDIT^GMPLX(CHNGE,"")
94 D DTMOD^GMPLX(GMPIFN)
95 L -^AUPNPROB(GMPIFN,0)
96 S RETURN=1
97 S RETURN(0)=""
98 Q
99INACT(RETURN,GMPIFN) ; -- inactivate a problem
100 ; RETURN: ;(consistent with UPDATE function)
101 ; SUCCESS:
102 ; RETURN>0, RETURN(0)=""
103 ; FAILURE:
104 ; RETURN<0, RETURN(0)=verbose error message
105 N NOW,CHNGE
106 S NOW=$$HTFM^XLFDT($H)
107 I $P(^AUPNPROB(GMPIFN,0),U,12)'="A" D Q ; BAIL OUT - ALREADY INACTIVE
108 . S RETURN=-1
109 . S RETURN(0)="Problem Already Inactive"
110 L +^AUPNPROB(GMPIFN,0):10
111 I '$T D Q ; BAIL OUT - NO LOCK
112 . S RETURN=-1
113 . S RETURN(0)="Record in use. Try again in a few moments"
114 S $P(^AUPNPROB(GMPIFN,0),U,12)="I"
115 S CHNGE=GMPIFN_"^.12^"_NOW_U_DUZ_"^A^I^Inactivated^"_DUZ
116 D AUDIT^GMPLX(CHNGE,"")
117 D DTMOD^GMPLX(GMPIFN)
118 L -^AUPNPROB(GMPIFN,0)
119 S RETURN=1
120 S RETURN(0)=""
121 Q
122OLDCOMM(ORY,PIFN) ; Return comments for a problem - SINGLE DIVISION!
123 ;N FAC,NIFN,NOTE,NOTECNT
124 ;S NOTECNT=0
125 ;S FAC=$O(^AUPNPROB(PIFN,11,"B",+$G(DUZ(2)),0)) Q:'FAC
126 ;F NIFN=0:0 S NIFN=$O(^AUPNPROB(PIFN,11,FAC,11,"B",NIFN)) Q:NIFN'>0 D
127 ;. Q:$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,4)'="A"
128 ;. S NOTE=$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,3)
129 ;. S NOTECNT=NOTECNT+1,ORY(NOTECNT)=NOTE
130 Q
131GETCOMM(ORY,PIFN) ; Return comments for a problem - MULTI-DIVISIONAL
132 N FAC,NIFN,NOTE,NOTECNT
133 S NOTECNT=0,FAC=0
134 F S FAC=$O(^AUPNPROB(PIFN,11,FAC)) Q:+FAC'>0 D
135 . S NIFN=0
136 . F S NIFN=$O(^AUPNPROB(PIFN,11,FAC,11,NIFN)) Q:NIFN'>0 D
137 . . Q:$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,4)'="A"
138 . . S NOTE=$P($G(^AUPNPROB(PIFN,11,FAC,11,NIFN,0)),U,3)
139 . . S NOTECNT=NOTECNT+1,ORY(NOTECNT)=NOTE
140 Q
141SAVEVIEW(Y,GMPLVIEW) ; -- save new view in File #200/Field #125
142 N TMP
143 Q:'$D(GMPLVIEW)
144 S TMP=$P($G(^VA(200,DUZ,125)),U,2,999)
145 S ^VA(200,DUZ,125)=$P(GMPLVIEW,U,1)_U_TMP
146 S TMP=$$GET^XPAR(DUZ_";VA(200,","ORCH CONTEXT PROBLEMS",1)
147 I TMP'="" D Q
148 . D CHG^XPAR(DUZ_";VA(200,","ORCH CONTEXT PROBLEMS",1,$P(GMPLVIEW,U,2))
149 D ADD^XPAR(DUZ_";VA(200,","ORCH CONTEXT PROBLEMS",1,$P(GMPLVIEW,U,2))
150 Q
151 ;
Note: See TracBrowser for help on using the repository browser.