source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJLS4.m@ 701

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

revised back to 6/30/08 version

File size: 7.1 KB
Line 
1MAGJLS4 ;WIRMFO/JHC VistARad RPCs--History List ; 29 Jul 2003 10:00 AM
2 ;;3.0;IMAGING;**18**;Mar 07, 2006
3 ;; +---------------------------------------------------------------+
4 ;; | Property of the US Government. |
5 ;; | No permission to copy or redistribute this software is given. |
6 ;; | Use of unreleased versions of this software requires the user |
7 ;; | to execute a written test agreement with the VistA Imaging |
8 ;; | Development Office of the Department of Veterans Affairs, |
9 ;; | telephone (301) 734-0100. |
10 ;; | |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18 Q
19ERR N ERR S ERR=$$EC^%ZOSV S ^TMP($J,"RET",0)="0^4~"_ERR
20 S MAGGRY=$NA(^TMP($J,"RET"))
21 D @^%ZOSF("ERRTN")
22 Q:$Q 1 Q
23 ;
24 ; Subroutines for Vistarad History List functions
25 ; Entry Points:
26 ; HIST -- All History List rpcs go here
27 ;
28HIST(MAGGRY,PARAMS,DATA) ; History List RPC: MAGJ HISTORYLIST
29 ; PARAMS--TXID ^ TXDUZ ^ TXDIV
30 ; TXID: Required; designates action to take; see below
31 ; TXDUZ: Optional; if supplied, get data for another user (Read Only)
32 ; TXDIV: Optional; if supplied, get data for another division (Read Only)
33 ; Note: for now, TXDIV is forced to the Logon Division
34 ; DATA--(optional) array of input data; depends on TXID; see subroutines by TXID
35 ;
36 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJLS4"
37 N TXID,TXDUZ,TXDIV,UPDATEOK,DIQUIET,REPLY
38 K ^TMP($J,"RET")
39 S TXID=+PARAMS,TXDUZ=+$P(PARAMS,U,2),TXDIV=+$P(PARAMS,U,3)
40 I 'TXDUZ S TXDUZ=DUZ
41 S UPDATEOK=TXDUZ=DUZ
42 S TXDIV=DUZ(2) ; Force to Logon Division for now
43 S REPLY="0^1~Performing History List operation."
44 I 'TXID!'("1,2,3"[TXID) S REPLY="0^4~Invalid History List operation requested." G HISTZ
45 I '$D(DATA)&(TXID=1!TXID=3) S REPLY="0^4~No data supplied for History List update/delete." G HISTZ
46 I 'UPDATEOK&("1,3"[TXID) S REPLY="0^4~The current History List may not be updated by the current user." G HISTZ
47 S DIQUIET=1 D DT^DICRW
48 I TXID=1 D HISTADD(.DATA,TXDUZ,TXDIV) G HISTZ
49 I TXID=2 D HISTUPD(TXDUZ,TXDIV) D HISTGET(TXDUZ,TXDIV) G HISTZ
50 I TXID=3 D HISTDEL(.DATA,TXDUZ,TXDIV) G HISTZ
51 ; I TXID=4 D HISTUPD(TXDUZ,TXDIV) G HISTZ ; for now, do this function with txid 2
52HISTZ ;
53 I 'REPLY S MAGGRY=$NA(^TMP($J,"RET")),@MAGGRY@(0)=REPLY
54 E ; maggry otherwise has been set by called subroutine
55 Q
56 ;
57HISTADD(DATA,TXDUZ,TXDIV) ; add records
58 N IDATA,ILOOP,CT,NOGO,EXID,HISDAT,HISTIEN,MAGRACNT
59 S IDATA="",CT=0,NOGO=0
60 F ILOOP=0:1 S IDATA=$O(DATA(IDATA)) Q:IDATA="" D
61 . S EXID=$P(DATA(IDATA),"|"),HISDAT=$P(DATA(IDATA),"|",2)
62 . F I=1:1:4 I '+$P(EXID,U,I) S NOGO=1 Q
63 . I NOGO Q
64 . L +^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV):2
65 . E Q
66 . S X=$G(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,0)),HISTIEN=+$P(X,U)+1,$P(^(0),U)=HISTIEN
67 . L -^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV)
68 . S ^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,0,"ADD",HISTIEN)="|"_EXID_"|"_HISTIEN_U_HISDAT_"|"
69 . S CT=CT+1
70 I 'CT S REPLY="0^3~"_$S(ILOOP:"Unable to add records",1:"No records to add")_" to History List." Q
71 S MAGRACNT=0 D ACTIVE^MAGJLS2(.MAGGRY,9996)
72 S X=@MAGGRY@(0),X=+X_U_"1~"_$$HISTTL(TXDUZ,TXDIV),@MAGGRY@(0)=X
73 N TS S TS="" F I=2,0 S %H=$H+I D YMD^%DTC S TS=TS_$S(TS="":"",1:U)_X
74 S ^XTMP("MAGJ2",0)=TS_U_"VistaRad List Compile"
75 S REPLY=1
76 Q
77 ;
78HISTTL(TXDUZ,TXDIV) ; Build list title string
79 N LSTTL
80 S LSTTL="HISTORY LIST for "_$$USERINF^MAGJUTL3(TXDUZ,.01)_" at "_"Station #"_$$STATN^MAGJEX1(TXDIV)
81 S LSTTL=LSTTL_"|"_TXDUZ ; provide report's DUZ to client
82 Q LSTTL
83 ;
84HISTGET(TXDUZ,TXDIV) ; Get full History List for input user for division txdiv
85 N MAGLST,LSTTL,LSTID,MAGLST
86 S TXDUZ=$G(TXDUZ,DUZ)
87 S TXDIV=$G(TXDIV,DUZ(2))
88 D PARAMS^MAGJLS2B(9996)
89 I 'LSTID S REPLY="0^4~Problem with History List Compile." Q
90 S LSTTL=$$HISTTL(TXDUZ,DUZ(2))
91 S X=$O(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,0))
92 I 'X S REPLY="0^1~No exams found for: "_LSTTL Q
93 S MAGLST=$NA(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV))
94 D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,MAGLST)
95 S REPLY=1
96 Q
97 ;
98HISTDEL(DATA,TXDUZ,TXDIV) ; delete records
99 N IDATA,CT,HISTIEN,ALLDONE,LAST
100 S IDATA="",CT=0,ALLDONE=0
101 L +^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV):2
102 E S REPLY="0^2~Unable to access HISTORY File for deleting records; try again later." Q
103 S MAGGRY=$NA(^TMP($J,"RET"))
104 F S IDATA=$O(DATA(IDATA)) Q:IDATA=""!ALLDONE D
105 . S HISTIEN=$P(DATA(IDATA),U)
106 . I HISTIEN,$D(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,HISTIEN)) K ^(HISTIEN) S CT=CT+1,@MAGGRY@(CT)=HISTIEN Q
107 . E I HISTIEN="ALL" S HISTIEN=0 D S ALLDONE=1
108 . . F S HISTIEN=$O(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,HISTIEN)) Q:'HISTIEN K ^(HISTIEN) S CT=CT+1,@MAGGRY@(CT)=HISTIEN
109 I '$D(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,0,"ADD")) S X=$O(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,""),-1),^(0)=X_U_X
110 L -^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV)
111 I 'CT S REPLY="0^3~No HISTORY List records found to delete."
112 E S REPLY=CT_"^1~"_CT_" HISTORY List records deleted."
113 S @MAGGRY@(0)=REPLY
114 S REPLY=1
115 Q
116 ;
117HISTUPD(TXDUZ,TXDIV) ; Update selected fields in History List
118 N LSTTL,CT,NOHIT,RAST,STATUS,REMOTE,RIST1,RIST2,RIST,RISTISME
119 N EXID,HISTIEN,RARPT,RADFN,RADTI,RACNI,XX1,XX2,T,X,DELETED,HDATE
120 S CT=0,NOHIT=0
121 S TXDUZ=$G(TXDUZ,DUZ)
122 S TXDIV=$G(TXDIV,DUZ(2))
123 S LSTTL=$$HISTTL(TXDUZ,DUZ(2))
124 S X=$O(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,0))
125 I 'X S REPLY="0^1~No exams found for: "_LSTTL Q
126 L +^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV):2
127 E S REPLY="0^2~Unable to access HISTORY File for updating records; try again later." Q
128 S HISTIEN=0
129 F S HISTIEN=$O(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,HISTIEN)) Q:'HISTIEN S XX1=$G(^(HISTIEN,1)),XX2=$G(^(2)) D
130 . S EXID=$P(XX2,"|",2),RARPT=+$P(EXID,U,4),RADFN=+$P(EXID,U),RADTI=+$P(EXID,U,2),RACNI=+$P(EXID,U,3)
131 . ; <*> Below is for phase 1 Alpha, til have final user setting for this <*> to be removed
132 . ; Age limit parameter to be passed in with txid 2 rpc call; setting is on client <*>
133 . S HDATE=$P(XX2,U,13) D Q:DELETED
134 . . S DELETED=0,HDATE=$P(HDATE,"@")
135 . . S X=HDATE,%DT="" D ^%DT S X=Y D H^%DTC K %DT
136 . . I %H<($H-3) K ^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,HISTIEN) S DELETED=1 Q
137 . ; <*> End of temp change
138 . I RARPT,RADFN,RADTI,RACNI
139 . E S NOHIT=NOHIT+1 Q
140 . D IMGINFO^MAGJUTL2(RARPT,.X) S REMOTE=$P(X,U,4)
141 . S X=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
142 . I X="" Q ; rad exam deleted
143 . S RAST=$P(X,U,3),RIST1=$P(X,U,12),RIST2=$P(X,U,15)
144 . S STATUS=$S(RAST:$P(^RA(72,RAST,0),U),1:"")
145 . S (RIST,RISTISME)=""
146 . I RIST1!RIST2 S X=$$RIST^MAGJUTL1(RIST1,RIST2),RIST=$P(X,U),RISTISME=$P(X,U,2)
147 . S RISTISME=$S(RISTISME:"Y",1:"N")
148 . S $P(XX1,U,16)=RAST,$P(XX1,U,8)=STATUS,$P(XX1,U,12)=REMOTE
149 . S T=$P(XX2,"|"),$P(T,U,3)=RIST,$P(T,U,7)=RISTISME,$P(XX2,"|")=T
150 . S ^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,HISTIEN,1)=XX1,^(2)=XX2
151 . S CT=CT+1
152 S X=$O(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,""),-1),^(0)=X_U_X ; <*> for phase 1 alpha only?
153 L -^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV)
154 S REPLY="0^1~HISTORY File records updated." Q
155 Q
156 ;
157END Q ;
Note: See TracBrowser for help on using the repository browser.