MAGJLS4 ;WIRMFO/JHC - VistARad RPCs--History List ; 10/17/2022
;;3.0;IMAGING;**18,76,101,341**;Dec 21, 2022;Build 28
;;Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
;; ISI IMAGING;**99**
Q
ERR N ERR S ERR=$$EC^%ZOSV S ^TMP($J,"RET",0)="0^4~"_ERR
S MAGGRY=$NA(^TMP($J,"RET"))
D @^%ZOSF("ERRTN")
Q:$Q 1 Q
;
; Subroutines for Vistarad History List functions
; Entry Points:
; HIST -- All History List rpcs go here
;
HIST(MAGGRY,PARAMS,DATA) ; History List RPC: MAGJ HISTORYLIST
; PARAMS--TXID ^ TXDUZ ^ TXDIV
; TXID: Required; designates action to take; see below
; TXDUZ: Optional; if supplied, get data for another user (Read Only)
; TXDIV: Optional; if supplied, get data for another division (Read Only)
; Note: for now, TXDIV is forced to the Logon Division
; DATA--(optional) array of input data; depends on TXID; see subroutines by TXID
;
N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJLS4"
N TXID,TXDUZ,TXDIV,UPDATEOK,DIQUIET,REPLY
K ^TMP($J,"RET")
S TXID=+PARAMS,TXDUZ=+$P(PARAMS,U,2),TXDIV=+$P(PARAMS,U,3)
I 'TXDUZ S TXDUZ=DUZ
S UPDATEOK=TXDUZ=DUZ
S TXDIV=DUZ(2) ; Force to Logon Division for now
S REPLY="0^1~Performing History List operation."
I 'TXID!'("1,2,3"[TXID) S REPLY="0^4~Invalid History List operation requested." G HISTZ
I '$D(DATA)&(TXID=1!TXID=3) S REPLY="0^4~No data supplied for History List update/delete." G HISTZ
I 'UPDATEOK&("1,3"[TXID) S REPLY="0^4~The current History List may not be updated by the current user." G HISTZ
S DIQUIET=1 D DT^DICRW
I TXID=1 D HISTADD(.DATA,TXDUZ,TXDIV) G HISTZ
I TXID=2 D HISTUPD(TXDUZ,TXDIV) D HISTGET(TXDUZ,TXDIV) G HISTZ
I TXID=3 D HISTDEL(.DATA,TXDUZ,TXDIV) G HISTZ
; I TXID=4 D HISTUPD(TXDUZ,TXDIV) G HISTZ ; for now, do this function with txid 2
HISTZ ;
I 'REPLY S MAGGRY=$NA(^TMP($J,"RET")),@MAGGRY@(0)=REPLY
E ; maggry otherwise has been set by called subroutine
Q
;
HISTADD(DATA,TXDUZ,TXDIV) ; add records
N IDATA,ILOOP,CT,NOGO,EXID,HISDAT,HISTIEN,MAGRACNT,TS
S IDATA="",CT=0,NOGO=0
F ILOOP=0:1 S IDATA=$O(DATA(IDATA)) Q:IDATA="" D
. S EXID=$P(DATA(IDATA),"|"),HISDAT=$P(DATA(IDATA),"|",2)
. F I=1:1:4 I '+$P(EXID,U,I) S NOGO=1 Q
. I NOGO Q
. L +^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV):2
. E Q
. S X=$G(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,0)),HISTIEN=+$P(X,U)+1,$P(^(0),U)=HISTIEN
. L -^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV)
. S ^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,0,"ADD",HISTIEN)="|"_EXID_"|"_HISTIEN_U_HISDAT_"|"
. S CT=CT+1
I 'CT S REPLY="0^3~"_$S(ILOOP:"Unable to add records",1:"No records to add")_" to History List." Q
S MAGRACNT=0 D ACTIVE^MAGJLS2(.MAGGRY,9996)
S X=@MAGGRY@(0),X=+X_U_"1~"_$$HISTTL(TXDUZ,TXDIV),@MAGGRY@(0)=X
S TS="" F I=2,0 S TS=TS_$S(TS="":"",1:U)_$$HTFM^XLFDT($H+I,0)
S ^XTMP("MAGJ2",0)=TS_U_"VistaRad List Compile"
S REPLY=1
Q
;
HISTTL(TXDUZ,TXDIV) ; Build list title string
N LSTTL
S LSTTL="HISTORY LIST for "_$$USERINF^MAGJUTL3(TXDUZ,.01)_" at "_"Station #"_$$STATN^MAGJEX1(TXDIV)
S LSTTL=LSTTL_"|"_TXDUZ ; provide report's DUZ to client
Q LSTTL
;
HISTGET(TXDUZ,TXDIV) ; Get full History List for input user for division txdiv
N MAGLST,LSTTL,LSTID,MAGLST
S TXDUZ=$G(TXDUZ,DUZ)
S TXDIV=$G(TXDIV,DUZ(2))
N DATA01 S DATA01=9996 ; ISI
D PARAMS^MAGJLS2B(9996)
I 'LSTID S REPLY="0^4~Problem with History List Compile." Q
S LSTTL=$$HISTTL(TXDUZ,DUZ(2))
S X=$O(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,0))
I 'X S REPLY="0^1~No exams found for: "_LSTTL Q
S MAGLST=$NA(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV))
D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,MAGLST)
S REPLY=1
Q
;
HISTDEL(DATA,TXDUZ,TXDIV) ; delete records
N IDATA,CT,HISTIEN,ALLDONE,LAST
S IDATA="",CT=0,ALLDONE=0
L +^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV):2
E S REPLY="0^2~Unable to access HISTORY File for deleting records; try again later." Q
S MAGGRY=$NA(^TMP($J,"RET"))
F S IDATA=$O(DATA(IDATA)) Q:IDATA=""!ALLDONE D
. S HISTIEN=$P(DATA(IDATA),U)
. I HISTIEN,$D(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,HISTIEN)) K ^(HISTIEN) S CT=CT+1,@MAGGRY@(CT)=HISTIEN Q
. E I HISTIEN="ALL" S HISTIEN=0 D S ALLDONE=1
. . F S HISTIEN=$O(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,HISTIEN)) Q:'HISTIEN K ^(HISTIEN) S CT=CT+1,@MAGGRY@(CT)=HISTIEN
I '$D(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,0,"ADD")) S X=$O(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,""),-1),^(0)=X_U_X
L -^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV)
I 'CT S REPLY="0^3~No HISTORY List records found to delete."
E S REPLY=CT_"^1~"_CT_" HISTORY List records deleted."
S @MAGGRY@(0)=REPLY
S REPLY=1
Q
;
HISTUPD(TXDUZ,TXDIV) ; Update selected fields in History List
N LSTTL,CT,NOHIT,RAST,STATUS,REMOTE,RIST1,RIST2,RIST,RISTISME
N EXID,HISTIEN,RARPT,RADFN,RADTI,RACNI,XX1,XX2,T,X,DELETED,HDATE
S CT=0,NOHIT=0
S TXDUZ=$G(TXDUZ,DUZ)
S TXDIV=$G(TXDIV,DUZ(2))
S LSTTL=$$HISTTL(TXDUZ,DUZ(2))
S X=$O(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,0))
I 'X S REPLY="0^1~No exams found for: "_LSTTL Q
L +^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV):2
E S REPLY="0^2~Unable to access HISTORY File for updating records; try again later." Q
S HISTIEN=0
F S HISTIEN=$O(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,HISTIEN)) Q:'HISTIEN S XX1=$G(^(HISTIEN,1)),XX2=$G(^(2)) D
. S EXID=$P(XX2,"|",2),RARPT=+$P(EXID,U,4),RADFN=+$P(EXID,U),RADTI=+$P(EXID,U,2),RACNI=+$P(EXID,U,3)
. ; <*> Below is for phase 1 Alpha, til have final user setting for this <*> to be removed
. ; Age limit parameter to be passed in with txid 2 rpc call; setting is on client <*>
. S HDATE=$P(XX2,U,13) D Q:DELETED
. . S DELETED=0,HDATE=$P(HDATE,"@")
. . S X=HDATE,%DT="" D ^%DT K %DT
. . I $$FMTH^XLFDT(Y,1)<($H-3) K ^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,HISTIEN) S DELETED=1 Q
. ; <*> End of temp change
. I RARPT,RADFN,RADTI,RACNI
. E S NOHIT=NOHIT+1 Q
. D IMGINFO^MAGJUTL2(RARPT,.X) S REMOTE=$P(X,U,4)
. S X=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
. I X="" Q ; rad exam deleted
. S RAST=$P(X,U,3),RIST1=$P(X,U,12),RIST2=$P(X,U,15)
. S STATUS=$S(RAST:$P(^RA(72,RAST,0),U),1:"")
. S (RIST,RISTISME)=""
. I RIST1!RIST2 S X=$$RIST^MAGJUTL1(RIST1,RIST2),RIST=$P(X,U),RISTISME=$P(X,U,2)
. S RISTISME=$$RISTISME^MAGJLS2B(RISTISME)
. S $P(XX1,U,16)=RAST,$P(XX1,U,8)=STATUS,$P(XX1,U,12)=REMOTE
. S T=$P(XX2,"|"),$P(T,U,3)=RIST,$P(T,U,7)=RISTISME,$P(XX2,"|")=T
. S ^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,HISTIEN,1)=XX1,^(2)=XX2
. S CT=CT+1
S X=$O(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,""),-1),^(0)=X_U_X ; <*> for phase 1 alpha only?
L -^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV)
S REPLY="0^1~HISTORY File records updated." Q
Q
;
END Q ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGJLS4 7615 printed Sep 23, 2025@19:43:06 Page 2
MAGJLS4 ;WIRMFO/JHC - VistARad RPCs--History List ; 10/17/2022
+1 ;;3.0;IMAGING;**18,76,101,341**;Dec 21, 2022;Build 28
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+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 ;; ISI IMAGING;**99**
+19 QUIT
ERR NEW ERR
SET ERR=$$EC^%ZOSV
SET ^TMP($JOB,"RET",0)="0^4~"_ERR
+1 SET MAGGRY=$NAME(^TMP($JOB,"RET"))
+2 DO @^%ZOSF("ERRTN")
+3 if $QUIT
QUIT 1
QUIT
+4 ;
+5 ; Subroutines for Vistarad History List functions
+6 ; Entry Points:
+7 ; HIST -- All History List rpcs go here
+8 ;
HIST(MAGGRY,PARAMS,DATA) ; History List RPC: MAGJ HISTORYLIST
+1 ; PARAMS--TXID ^ TXDUZ ^ TXDIV
+2 ; TXID: Required; designates action to take; see below
+3 ; TXDUZ: Optional; if supplied, get data for another user (Read Only)
+4 ; TXDIV: Optional; if supplied, get data for another division (Read Only)
+5 ; Note: for now, TXDIV is forced to the Logon Division
+6 ; DATA--(optional) array of input data; depends on TXID; see subroutines by TXID
+7 ;
+8 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^MAGJLS4"
+9 NEW TXID,TXDUZ,TXDIV,UPDATEOK,DIQUIET,REPLY
+10 KILL ^TMP($JOB,"RET")
+11 SET TXID=+PARAMS
SET TXDUZ=+$PIECE(PARAMS,U,2)
SET TXDIV=+$PIECE(PARAMS,U,3)
+12 IF 'TXDUZ
SET TXDUZ=DUZ
+13 SET UPDATEOK=TXDUZ=DUZ
+14 ; Force to Logon Division for now
SET TXDIV=DUZ(2)
+15 SET REPLY="0^1~Performing History List operation."
+16 IF 'TXID!'("1,2,3"[TXID)
SET REPLY="0^4~Invalid History List operation requested."
GOTO HISTZ
+17 IF '$DATA(DATA)&(TXID=1!TXID=3)
SET REPLY="0^4~No data supplied for History List update/delete."
GOTO HISTZ
+18 IF 'UPDATEOK&("1,3"[TXID)
SET REPLY="0^4~The current History List may not be updated by the current user."
GOTO HISTZ
+19 SET DIQUIET=1
DO DT^DICRW
+20 IF TXID=1
DO HISTADD(.DATA,TXDUZ,TXDIV)
GOTO HISTZ
+21 IF TXID=2
DO HISTUPD(TXDUZ,TXDIV)
DO HISTGET(TXDUZ,TXDIV)
GOTO HISTZ
+22 IF TXID=3
DO HISTDEL(.DATA,TXDUZ,TXDIV)
GOTO HISTZ
+23 ; I TXID=4 D HISTUPD(TXDUZ,TXDIV) G HISTZ ; for now, do this function with txid 2
HISTZ ;
+1 IF 'REPLY
SET MAGGRY=$NAME(^TMP($JOB,"RET"))
SET @MAGGRY@(0)=REPLY
+2 ; maggry otherwise has been set by called subroutine
IF '$TEST
+3 QUIT
+4 ;
HISTADD(DATA,TXDUZ,TXDIV) ; add records
+1 NEW IDATA,ILOOP,CT,NOGO,EXID,HISDAT,HISTIEN,MAGRACNT,TS
+2 SET IDATA=""
SET CT=0
SET NOGO=0
+3 FOR ILOOP=0:1
SET IDATA=$ORDER(DATA(IDATA))
if IDATA=""
QUIT
Begin DoDot:1
+4 SET EXID=$PIECE(DATA(IDATA),"|")
SET HISDAT=$PIECE(DATA(IDATA),"|",2)
+5 FOR I=1:1:4
IF '+$PIECE(EXID,U,I)
SET NOGO=1
QUIT
+6 IF NOGO
QUIT
+7 LOCK +^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV):2
+8 IF '$TEST
QUIT
+9 SET X=$GET(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,0))
SET HISTIEN=+$PIECE(X,U)+1
SET $PIECE(^(0),U)=HISTIEN
+10 LOCK -^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV)
+11 SET ^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,0,"ADD",HISTIEN)="|"_EXID_"|"_HISTIEN_U_HISDAT_"|"
+12 SET CT=CT+1
End DoDot:1
+13 IF 'CT
SET REPLY="0^3~"_$SELECT(ILOOP:"Unable to add records",1:"No records to add")_" to History List."
QUIT
+14 SET MAGRACNT=0
DO ACTIVE^MAGJLS2(.MAGGRY,9996)
+15 SET X=@MAGGRY@(0)
SET X=+X_U_"1~"_$$HISTTL(TXDUZ,TXDIV)
SET @MAGGRY@(0)=X
+16 SET TS=""
FOR I=2,0
SET TS=TS_$SELECT(TS="":"",1:U)_$$HTFM^XLFDT($HOROLOG+I,0)
+17 SET ^XTMP("MAGJ2",0)=TS_U_"VistaRad List Compile"
+18 SET REPLY=1
+19 QUIT
+20 ;
HISTTL(TXDUZ,TXDIV) ; Build list title string
+1 NEW LSTTL
+2 SET LSTTL="HISTORY LIST for "_$$USERINF^MAGJUTL3(TXDUZ,.01)_" at "_"Station #"_$$STATN^MAGJEX1(TXDIV)
+3 ; provide report's DUZ to client
SET LSTTL=LSTTL_"|"_TXDUZ
+4 QUIT LSTTL
+5 ;
HISTGET(TXDUZ,TXDIV) ; Get full History List for input user for division txdiv
+1 NEW MAGLST,LSTTL,LSTID,MAGLST
+2 SET TXDUZ=$GET(TXDUZ,DUZ)
+3 SET TXDIV=$GET(TXDIV,DUZ(2))
+4 ; ISI
NEW DATA01
SET DATA01=9996
+5 DO PARAMS^MAGJLS2B(9996)
+6 IF 'LSTID
SET REPLY="0^4~Problem with History List Compile."
QUIT
+7 SET LSTTL=$$HISTTL(TXDUZ,DUZ(2))
+8 SET X=$ORDER(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,0))
+9 IF 'X
SET REPLY="0^1~No exams found for: "_LSTTL
QUIT
+10 SET MAGLST=$NAME(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV))
+11 DO LSTOUT^MAGJLS2B(.MAGGRY,LSTID,MAGLST)
+12 SET REPLY=1
+13 QUIT
+14 ;
HISTDEL(DATA,TXDUZ,TXDIV) ; delete records
+1 NEW IDATA,CT,HISTIEN,ALLDONE,LAST
+2 SET IDATA=""
SET CT=0
SET ALLDONE=0
+3 LOCK +^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV):2
+4 IF '$TEST
SET REPLY="0^2~Unable to access HISTORY File for deleting records; try again later."
QUIT
+5 SET MAGGRY=$NAME(^TMP($JOB,"RET"))
+6 FOR
SET IDATA=$ORDER(DATA(IDATA))
if IDATA=""!ALLDONE
QUIT
Begin DoDot:1
+7 SET HISTIEN=$PIECE(DATA(IDATA),U)
+8 IF HISTIEN
IF $DATA(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,HISTIEN))
KILL ^(HISTIEN)
SET CT=CT+1
SET @MAGGRY@(CT)=HISTIEN
QUIT
+9 IF '$TEST
IF HISTIEN="ALL"
SET HISTIEN=0
Begin DoDot:2
+10 FOR
SET HISTIEN=$ORDER(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,HISTIEN))
if 'HISTIEN
QUIT
KILL ^(HISTIEN)
SET CT=CT+1
SET @MAGGRY@(CT)=HISTIEN
End DoDot:2
SET ALLDONE=1
End DoDot:1
+11 IF '$DATA(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,0,"ADD"))
SET X=$ORDER(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,""),-1)
SET ^(0)=X_U_X
+12 LOCK -^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV)
+13 IF 'CT
SET REPLY="0^3~No HISTORY List records found to delete."
+14 IF '$TEST
SET REPLY=CT_"^1~"_CT_" HISTORY List records deleted."
+15 SET @MAGGRY@(0)=REPLY
+16 SET REPLY=1
+17 QUIT
+18 ;
HISTUPD(TXDUZ,TXDIV) ; Update selected fields in History List
+1 NEW LSTTL,CT,NOHIT,RAST,STATUS,REMOTE,RIST1,RIST2,RIST,RISTISME
+2 NEW EXID,HISTIEN,RARPT,RADFN,RADTI,RACNI,XX1,XX2,T,X,DELETED,HDATE
+3 SET CT=0
SET NOHIT=0
+4 SET TXDUZ=$GET(TXDUZ,DUZ)
+5 SET TXDIV=$GET(TXDIV,DUZ(2))
+6 SET LSTTL=$$HISTTL(TXDUZ,DUZ(2))
+7 SET X=$ORDER(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,0))
+8 IF 'X
SET REPLY="0^1~No exams found for: "_LSTTL
QUIT
+9 LOCK +^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV):2
+10 IF '$TEST
SET REPLY="0^2~Unable to access HISTORY File for updating records; try again later."
QUIT
+11 SET HISTIEN=0
+12 FOR
SET HISTIEN=$ORDER(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,HISTIEN))
if 'HISTIEN
QUIT
SET XX1=$GET(^(HISTIEN,1))
SET XX2=$GET(^(2))
Begin DoDot:1
+13 SET EXID=$PIECE(XX2,"|",2)
SET RARPT=+$PIECE(EXID,U,4)
SET RADFN=+$PIECE(EXID,U)
SET RADTI=+$PIECE(EXID,U,2)
SET RACNI=+$PIECE(EXID,U,3)
+14 ; <*> Below is for phase 1 Alpha, til have final user setting for this <*> to be removed
+15 ; Age limit parameter to be passed in with txid 2 rpc call; setting is on client <*>
+16 SET HDATE=$PIECE(XX2,U,13)
Begin DoDot:2
+17 SET DELETED=0
SET HDATE=$PIECE(HDATE,"@")
+18 SET X=HDATE
SET %DT=""
DO ^%DT
KILL %DT
+19 IF $$FMTH^XLFDT(Y,1)<($HOROLOG-3)
KILL ^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,HISTIEN)
SET DELETED=1
QUIT
End DoDot:2
if DELETED
QUIT
+20 ; <*> End of temp change
+21 IF RARPT
IF RADFN
IF RADTI
IF RACNI
+22 IF '$TEST
SET NOHIT=NOHIT+1
QUIT
+23 DO IMGINFO^MAGJUTL2(RARPT,.X)
SET REMOTE=$PIECE(X,U,4)
+24 SET X=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+25 ; rad exam deleted
IF X=""
QUIT
+26 SET RAST=$PIECE(X,U,3)
SET RIST1=$PIECE(X,U,12)
SET RIST2=$PIECE(X,U,15)
+27 SET STATUS=$SELECT(RAST:$PIECE(^RA(72,RAST,0),U),1:"")
+28 SET (RIST,RISTISME)=""
+29 IF RIST1!RIST2
SET X=$$RIST^MAGJUTL1(RIST1,RIST2)
SET RIST=$PIECE(X,U)
SET RISTISME=$PIECE(X,U,2)
+30 SET RISTISME=$$RISTISME^MAGJLS2B(RISTISME)
+31 SET $PIECE(XX1,U,16)=RAST
SET $PIECE(XX1,U,8)=STATUS
SET $PIECE(XX1,U,12)=REMOTE
+32 SET T=$PIECE(XX2,"|")
SET $PIECE(T,U,3)=RIST
SET $PIECE(T,U,7)=RISTISME
SET $PIECE(XX2,"|")=T
+33 SET ^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,HISTIEN,1)=XX1
SET ^(2)=XX2
+34 SET CT=CT+1
End DoDot:1
+35 ; <*> for phase 1 alpha only?
SET X=$ORDER(^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV,""),-1)
SET ^(0)=X_U_X
+36 LOCK -^XTMP("MAGJ2","HISTORY",TXDUZ,TXDIV)
+37 SET REPLY="0^1~HISTORY File records updated."
QUIT
+38 QUIT
+39 ;
END ;
QUIT
