PSIVINDL.m

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 ---PSIVINDL   6204     printed  Feb 18, 2025@23:30:39                                                                                                                                                                                                    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