PSIVINDL ;SLC/SS - PROCESS IV ACTIVITY LOG ENTRIES FOR INDICATION ; Feb 02, 2022
;;5.0;INPATIENT MEDICATIONS;**399**;16 DEC 97;Build 64
;
;
;For IV orders only:
;Copy activity log entries for INDICATION (only) changes
;from NON-VERIFIED in the file (#53.1)
;to ACTIVE orders in the the file (#55)
;during verification process
CPINDLOG(PSDFN,PS531,PS55100,PSJREAS) ;
;PSDFN - patient's DFN
;PS531 - IEN of the file (#53.1)
;PS55100 - IEN of IV multiple field (#100) in the file (#55)
;PSJREAS - reason (optional)
N Z1,Z2,IEN,IEN2,NEWVAL,PSJTMP,NAME,REASON
S PS531=+PS531,PS55100=+PS55100
;get the current value of INDICATION and use as the latest "TO" value
S NEWVAL=$G(^PS(53.1,PS531,18))
;loop thru all INDICATION log entries in the file (#53.1) from newest to oldest and store all "TO" and "FROM" values in PSJTMP
S IEN=99999 F S IEN=$O(^PS(53.1,PS531,"A",IEN),-1) Q:+IEN=0 S Z1=$G(^PS(53.1,PS531,"A",IEN,0)) I $P(Z1,U,4)="INDICATION" D
. S NAME=$$GET1^DIQ(200,+$P(Z1,U,2),.01,"E")
. S REASON=$S('$G(PSJREAS):$$GET1^DIQ(53.3,+$P(Z1,U,3),.01,"E"),1:PSJREAS)
. S PSJTMP(IEN)=PSDFN_U_PS55100_U_"E"_U_NAME_U_REASON_U_+$P(Z1,U)_U_"INDICATION"_U_$P(Z1,U,5)_U_NEWVAL_U_+$P(Z1,U,2)
. S NEWVAL=$P(Z1,U,5)
S IEN2=0
F S IEN2=$O(PSJTMP(IEN2)) Q:+IEN2=0 S Z2=PSJTMP(IEN2) D ADDENTRY($P(Z2,U,1),$P(Z2,U,2),$P(Z2,U,3),$P(Z2,U,4),$P(Z2,U,5),$P(Z2,U,6),$P(Z2,U,7),$P(Z2,U,8),$P(Z2,U,9),$P(Z2,U,10))
Q
;
;Add one single entry to the subfile (#55.04) and its subentry in (#55.15)
ADDENTRY(PSDFN,PS55100,PSACTTYP,PSUSERNM,PSACTRES,PSACTDAT,PSFIELD,PSFROM,PSTO,PSDUZ) ;
;PSDFN - patient's DFN
;PS55100 - IEN of IV multiple field (#100) in the file (#55)
;PSACTTYP - activity type, see 55.04,.02
;PSUSERNM - User name (55.04,.03)
;PSACTRES - REASON FOR ACTIVITY (55.04,.04)
;PSACTDAT - ACTIVITY DATE (55.04,.05)
;PSDUZ - user DUZ (55.04,.06)
;PSFIELD - the field that was edited/changed
;PSFROM - old value
;PSTO - new value
S PS55100=+PS55100
N PS0NODE,PSMAXN,NEWIEN,PSJTMP,NEWIEN2
;get the max number used by 55.04,.01 ACTIVITY LOG
S PSMAXN=$$GETMAXN(PSDFN,PS55100)
;in the subfile 55.01,40 ACTIVITY LOG of the file (#55)
;create an 55.04 entry with PSMAXN+1 as ACTIVITY LOG value and populate fields: (#.02) TYPE OF ACTIVITY, (#.03) ENTRY CODE,
;(#.04) REASON FOR ACTIVITY, (#.05) ACTIVITY DATE, (#.06) USER
S NEWIEN=$$ADD5504(PS55100,PSDFN,PSMAXN+1,PSACTTYP,PSUSERNM,PSACTRES,PSACTDAT,PSDUZ)
;in the subfile 55.04,1 FIELD CHANGED of the file (#55)
;create an entry and populate fields: (#.01) FIELD CHANGED,(#1) FROM,(#2) TO
I $$ADD5515(NEWIEN,PS55100,PSDFN,PSFIELD,PSFROM,PSTO)
Q
;
;in the subfile 55.04,1 FIELD CHANGED of the file (#55)
;create an entry with PSFLCHNG as (#.01) value and populate fields: (#.01) FIELD CHANGED,(#1) FROM,(#2) TO
ADD5504(PS55100,PSDFN,PSMAXN,PSACTTYP,PSUSERNM,PSACTRES,PSACTDAT,PSDUZ) ;
N PSJTMP,NEWIEN,IENS
S NEWIEN=$$INSITEM(55.04,PS55100_","_PSDFN,PSMAXN,"")
;populate other fiedls
S IENS=""_NEWIEN_","_PS55100_","_PSDFN_","_""
S PSJTMP(55.04,IENS,.02)=PSACTTYP
S PSJTMP(55.04,IENS,.03)=PSUSERNM
S PSJTMP(55.04,IENS,.04)=PSACTRES
S PSJTMP(55.04,IENS,.05)=PSACTDAT
S PSJTMP(55.04,IENS,.06)=PSDUZ
D FILE^DIE("","PSJTMP")
Q NEWIEN
;
;in the subfile 55.04,1 FIELD CHANGED of the file (#55)
;create an entry with PSFLCHNG as (#.01) value and populate fields: (#.01) FIELD CHANGED,(#1) FROM,(#2) TO
ADD5515(IEN5515,PS55100,PSDFN,PSFLCHNG,PSFROM,PSTO) ;
N NEWIEN,PSJTMP,IENS
S NEWIEN=$$INSITEM(55.15,IEN5515_","_PS55100_","_PSDFN,PSFLCHNG,"")
;populate other fiedls
S IENS=""_NEWIEN_","_IEN5515_","_PS55100_","_PSDFN_","_""
S PSJTMP(55.15,IENS,1)=PSFROM
S PSJTMP(55.15,IENS,2)=PSTO
D FILE^DIE("","PSJTMP")
Q NEWIEN
;
; get max number for 55.04,.01
GETMAXN(DFN,IEN100) ;
N Z1,NUM,IEN55151 S NUM=0,IEN55151=0
F S IEN55151=$O(^PS(55,DFN,"IV",IEN100,"A",IEN55151)) Q:+IEN55151=0 S Z1=+^PS(55,DFN,"IV",IEN100,"A",IEN55151,0) I Z1>NUM S NUM=Z1
Q NUM
;
;generic API to insert an entry to the file or subfile
INSITEM(PSFILE,PSIEN,PSVAL01,NEWRECNO,PSFLGS,LCKGL,LCKTIME,PSNEWREC) ;
;PSFILE - file or subfile number
;PSIEN - ien of the parent file entry in which the new subfile entry will be inserted
; = "" - if insert to the top-level
; = IEN0 - when you insert to the "child" level - i.e. 1st level after top-level
; IEN0 is the top-leveltop-level IEN
; = "IEN1,IEN0" - when you insert to the "grandchild" level - i.e. 2nd level after top-level
; IEN0 is the top-leveltop-level IEN
; IEN1 is the 1st level IEN
; = "IEN2,IEN1,IEN0" - when you insert to the 3rd level after top-level
; IEN0 is the top-leveltop-level IEN
; IEN1 is the 1st level IEN
; IEN2 is the 2nd level IEN
;PSVAL01 - .01 value for the new entry
;NEWRECNO -(optional) specify IEN if you want specific value
; Note: "" then the system will assign the entry number itself.
;PSFLGS - FLAGS parameter for UPDATE^DIE
;LCKGL - fully specified global reference to lock
;LCKTIME - time out for LOCK, if LOCKTIME=0 then the function will not lock the file
;PSNEWREC - optional, flag = if 1 then allow to create a new top level record
;
;returns IEN of the new entry
;Examples:
; W $$INSITEM(55.04,PS55100_","_PSDFN,PSMAXN,"") - 2nd level
; W $$INSITEM(55.15,IEN5515_","_PS55100_","_PSDFN,PSFLCHNG,"") - 3rd level
I ('$G(PSFILE)) Q "0^Invalid parameter"
I +$G(PSNEWREC)=0 I $G(NEWRECNO)>0,'$G(PSIEN) Q "0^Invalid parameter"
I $G(PSVAL01)="" Q "0^Null"
N PSLOCK S PSLOCK=0
N PSSSI,PSIENS,PSFDA,PSERR
I '$G(NEWRECNO) N NEWRECNO S NEWRECNO=$G(NEWRECNO)
I PSIEN'="" S PSIENS="+1,"_PSIEN_"," I $L(NEWRECNO)>0 S PSSSI(1)=+NEWRECNO
I PSIEN="" S PSIENS="+1," I $L(NEWRECNO)>0 S PSSSI(1)=+NEWRECNO
S PSFDA(PSFILE,PSIENS,.01)=PSVAL01
I $L($G(LCKGL)) L +@LCKGL:(+$G(LCKTIME)) S PSLOCK=$T I 'PSLOCK Q -2 ;lock failure
D UPDATE^DIE($G(PSFLGS),"PSFDA","PSSSI","PSERR")
I PSLOCK L -@LCKGL
I $D(PSERR) D BMES^XPDUTL($G(PSERR("DIERR",1,"TEXT",1),"Update Error")) Q -1 ;D BMES^XPDUTL(PSERR("DIERR",1,"TEXT",1))
Q +$G(PSSSI(1))
;
;PSIVINDL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVINDL 6204 printed Apr 09, 2024@21:06:50 Page 2
PSIVINDL ;SLC/SS - PROCESS IV ACTIVITY LOG ENTRIES FOR INDICATION ; Feb 02, 2022
+1 ;;5.0;INPATIENT MEDICATIONS;**399**;16 DEC 97;Build 64
+2 ;
+3 ;
+4 ;For IV orders only:
+5 ;Copy activity log entries for INDICATION (only) changes
+6 ;from NON-VERIFIED in the file (#53.1)
+7 ;to ACTIVE orders in the the file (#55)
+8 ;during verification process
CPINDLOG(PSDFN,PS531,PS55100,PSJREAS) ;
+1 ;PSDFN - patient's DFN
+2 ;PS531 - IEN of the file (#53.1)
+3 ;PS55100 - IEN of IV multiple field (#100) in the file (#55)
+4 ;PSJREAS - reason (optional)
+5 NEW Z1,Z2,IEN,IEN2,NEWVAL,PSJTMP,NAME,REASON
+6 SET PS531=+PS531
SET PS55100=+PS55100
+7 ;get the current value of INDICATION and use as the latest "TO" value
+8 SET NEWVAL=$GET(^PS(53.1,PS531,18))
+9 ;loop thru all INDICATION log entries in the file (#53.1) from newest to oldest and store all "TO" and "FROM" values in PSJTMP
+10 SET IEN=99999
FOR
SET IEN=$ORDER(^PS(53.1,PS531,"A",IEN),-1)
if +IEN=0
QUIT
SET Z1=$GET(^PS(53.1,PS531,"A",IEN,0))
IF $PIECE(Z1,U,4)="INDICATION"
Begin DoDot:1
+11 SET NAME=$$GET1^DIQ(200,+$PIECE(Z1,U,2),.01,"E")
+12 SET REASON=$SELECT('$GET(PSJREAS):$$GET1^DIQ(53.3,+$PIECE(Z1,U,3),.01,"E"),1:PSJREAS)
+13 SET PSJTMP(IEN)=PSDFN_U_PS55100_U_"E"_U_NAME_U_REASON_U_+$PIECE(Z1,U)_U_"INDICATION"_U_$PIECE(Z1,U,5)_U_NEWVAL_U_+$PIECE(Z1,U,2)
+14 SET NEWVAL=$PIECE(Z1,U,5)
End DoDot:1
+15 SET IEN2=0
+16 FOR
SET IEN2=$ORDER(PSJTMP(IEN2))
if +IEN2=0
QUIT
SET Z2=PSJTMP(IEN2)
DO ADDENTRY($PIECE(Z2,U,1),$PIECE(Z2,U,2),$PIECE(Z2,U,3),$PIECE(Z2,U,4),$PIECE(Z2,U,5),$PIECE(Z2,U,6),$PIECE(Z2,U,7),$PIECE(Z2,U,8),$PIECE(Z2,U,9),$PIECE(Z2,U,10))
+17 QUIT
+18 ;
+19 ;Add one single entry to the subfile (#55.04) and its subentry in (#55.15)
ADDENTRY(PSDFN,PS55100,PSACTTYP,PSUSERNM,PSACTRES,PSACTDAT,PSFIELD,PSFROM,PSTO,PSDUZ) ;
+1 ;PSDFN - patient's DFN
+2 ;PS55100 - IEN of IV multiple field (#100) in the file (#55)
+3 ;PSACTTYP - activity type, see 55.04,.02
+4 ;PSUSERNM - User name (55.04,.03)
+5 ;PSACTRES - REASON FOR ACTIVITY (55.04,.04)
+6 ;PSACTDAT - ACTIVITY DATE (55.04,.05)
+7 ;PSDUZ - user DUZ (55.04,.06)
+8 ;PSFIELD - the field that was edited/changed
+9 ;PSFROM - old value
+10 ;PSTO - new value
+11 SET PS55100=+PS55100
+12 NEW PS0NODE,PSMAXN,NEWIEN,PSJTMP,NEWIEN2
+13 ;get the max number used by 55.04,.01 ACTIVITY LOG
+14 SET PSMAXN=$$GETMAXN(PSDFN,PS55100)
+15 ;in the subfile 55.01,40 ACTIVITY LOG of the file (#55)
+16 ;create an 55.04 entry with PSMAXN+1 as ACTIVITY LOG value and populate fields: (#.02) TYPE OF ACTIVITY, (#.03) ENTRY CODE,
+17 ;(#.04) REASON FOR ACTIVITY, (#.05) ACTIVITY DATE, (#.06) USER
+18 SET NEWIEN=$$ADD5504(PS55100,PSDFN,PSMAXN+1,PSACTTYP,PSUSERNM,PSACTRES,PSACTDAT,PSDUZ)
+19 ;in the subfile 55.04,1 FIELD CHANGED of the file (#55)
+20 ;create an entry and populate fields: (#.01) FIELD CHANGED,(#1) FROM,(#2) TO
+21 IF $$ADD5515(NEWIEN,PS55100,PSDFN,PSFIELD,PSFROM,PSTO)
+22 QUIT
+23 ;
+24 ;in the subfile 55.04,1 FIELD CHANGED of the file (#55)
+25 ;create an entry with PSFLCHNG as (#.01) value and populate fields: (#.01) FIELD CHANGED,(#1) FROM,(#2) TO
ADD5504(PS55100,PSDFN,PSMAXN,PSACTTYP,PSUSERNM,PSACTRES,PSACTDAT,PSDUZ) ;
+1 NEW PSJTMP,NEWIEN,IENS
+2 SET NEWIEN=$$INSITEM(55.04,PS55100_","_PSDFN,PSMAXN,"")
+3 ;populate other fiedls
+4 SET IENS=""_NEWIEN_","_PS55100_","_PSDFN_","_""
+5 SET PSJTMP(55.04,IENS,.02)=PSACTTYP
+6 SET PSJTMP(55.04,IENS,.03)=PSUSERNM
+7 SET PSJTMP(55.04,IENS,.04)=PSACTRES
+8 SET PSJTMP(55.04,IENS,.05)=PSACTDAT
+9 SET PSJTMP(55.04,IENS,.06)=PSDUZ
+10 DO FILE^DIE("","PSJTMP")
+11 QUIT NEWIEN
+12 ;
+13 ;in the subfile 55.04,1 FIELD CHANGED of the file (#55)
+14 ;create an entry with PSFLCHNG as (#.01) value and populate fields: (#.01) FIELD CHANGED,(#1) FROM,(#2) TO
ADD5515(IEN5515,PS55100,PSDFN,PSFLCHNG,PSFROM,PSTO) ;
+1 NEW NEWIEN,PSJTMP,IENS
+2 SET NEWIEN=$$INSITEM(55.15,IEN5515_","_PS55100_","_PSDFN,PSFLCHNG,"")
+3 ;populate other fiedls
+4 SET IENS=""_NEWIEN_","_IEN5515_","_PS55100_","_PSDFN_","_""
+5 SET PSJTMP(55.15,IENS,1)=PSFROM
+6 SET PSJTMP(55.15,IENS,2)=PSTO
+7 DO FILE^DIE("","PSJTMP")
+8 QUIT NEWIEN
+9 ;
+10 ; get max number for 55.04,.01
GETMAXN(DFN,IEN100) ;
+1 NEW Z1,NUM,IEN55151
SET NUM=0
SET IEN55151=0
+2 FOR
SET IEN55151=$ORDER(^PS(55,DFN,"IV",IEN100,"A",IEN55151))
if +IEN55151=0
QUIT
SET Z1=+^PS(55,DFN,"IV",IEN100,"A",IEN55151,0)
IF Z1>NUM
SET NUM=Z1
+3 QUIT NUM
+4 ;
+5 ;generic API to insert an entry to the file or subfile
INSITEM(PSFILE,PSIEN,PSVAL01,NEWRECNO,PSFLGS,LCKGL,LCKTIME,PSNEWREC) ;
+1 ;PSFILE - file or subfile number
+2 ;PSIEN - ien of the parent file entry in which the new subfile entry will be inserted
+3 ; = "" - if insert to the top-level
+4 ; = IEN0 - when you insert to the "child" level - i.e. 1st level after top-level
+5 ; IEN0 is the top-leveltop-level IEN
+6 ; = "IEN1,IEN0" - when you insert to the "grandchild" level - i.e. 2nd level after top-level
+7 ; IEN0 is the top-leveltop-level IEN
+8 ; IEN1 is the 1st level IEN
+9 ; = "IEN2,IEN1,IEN0" - when you insert to the 3rd level after top-level
+10 ; IEN0 is the top-leveltop-level IEN
+11 ; IEN1 is the 1st level IEN
+12 ; IEN2 is the 2nd level IEN
+13 ;PSVAL01 - .01 value for the new entry
+14 ;NEWRECNO -(optional) specify IEN if you want specific value
+15 ; Note: "" then the system will assign the entry number itself.
+16 ;PSFLGS - FLAGS parameter for UPDATE^DIE
+17 ;LCKGL - fully specified global reference to lock
+18 ;LCKTIME - time out for LOCK, if LOCKTIME=0 then the function will not lock the file
+19 ;PSNEWREC - optional, flag = if 1 then allow to create a new top level record
+20 ;
+21 ;returns IEN of the new entry
+22 ;Examples:
+23 ; W $$INSITEM(55.04,PS55100_","_PSDFN,PSMAXN,"") - 2nd level
+24 ; W $$INSITEM(55.15,IEN5515_","_PS55100_","_PSDFN,PSFLCHNG,"") - 3rd level
+25 IF ('$GET(PSFILE))
QUIT "0^Invalid parameter"
+26 IF +$GET(PSNEWREC)=0
IF $GET(NEWRECNO)>0
IF '$GET(PSIEN)
QUIT "0^Invalid parameter"
+27 IF $GET(PSVAL01)=""
QUIT "0^Null"
+28 NEW PSLOCK
SET PSLOCK=0
+29 NEW PSSSI,PSIENS,PSFDA,PSERR
+30 IF '$GET(NEWRECNO)
NEW NEWRECNO
SET NEWRECNO=$GET(NEWRECNO)
+31 IF PSIEN'=""
SET PSIENS="+1,"_PSIEN_","
IF $LENGTH(NEWRECNO)>0
SET PSSSI(1)=+NEWRECNO
+32 IF PSIEN=""
SET PSIENS="+1,"
IF $LENGTH(NEWRECNO)>0
SET PSSSI(1)=+NEWRECNO
+33 SET PSFDA(PSFILE,PSIENS,.01)=PSVAL01
+34 ;lock failure
IF $LENGTH($GET(LCKGL))
LOCK +@LCKGL:(+$GET(LCKTIME))
SET PSLOCK=$TEST
IF 'PSLOCK
QUIT -2
+35 DO UPDATE^DIE($GET(PSFLGS),"PSFDA","PSSSI","PSERR")
+36 IF PSLOCK
LOCK -@LCKGL
+37 ;D BMES^XPDUTL(PSERR("DIERR",1,"TEXT",1))
IF $DATA(PSERR)
DO BMES^XPDUTL($GET(PSERR("DIERR",1,"TEXT",1),"Update Error"))
QUIT -1
+38 QUIT +$GET(PSSSI(1))
+39 ;
+40 ;PSIVINDL
