PSB95P ;ASMR/hrubovcak - post-install for PSB patch 95 ;Jun 13, 2016 14:29:16
;;3.0;BAR CODE MED ADMIN;**95**;13 June 2016;Build 10
;
; fix for DE4250: modify PS EVSEND OR extended action protocol
; set sequence numbers for PSB BCBU RECEIVE and HMP XQOR EVENTS
Q
;
EN ;
D DT^DICRW,MES^XPDUTL("updating PS EVSEND OR protocol")
N DIC,G,ITM,J,PSBFMSG,PSBORIG,SEQMX,X,Y
S DIC=101,X="PS EVSEND OR",DIC(0)="Z" D ^DIC ; find PS EVSEND OR
; target protocol not found, write message, exit
I '(Y>0) D Q
. D MES^XPDUTL("*ERROR*: PS EVSEND OR protocol not found!")
. D MES^XPDUTL("IRM support staff should contact eHMP or BCMA development.")
;
; IEN for PS EVSEND OR is +Y
D GETS^DIQ(101,(+Y)_",","**","EN","PSBORIG","PSBFMSG") ; external format, skip null values
I $D(PSBFMSG("DIERR")) D Q ; list FileMan error, exit
. W !," FileMan error, retrieving ITEM values." S G="PSBFMSG(""DIERR"")"
. F S G=$Q(@G) Q:'(G["DIERR") D MES^XPDUTL(G_" = "_@G)
. D MES^XPDUTL($T(+0)_" post-init exited prematurely")
;
S ITM("1ST")="HMP XQOR EVENTS",ITM("2ND")="PSB BCBU RECEIVE" ; ITEM targets
S (ITM("1ST","IENS"),ITM("2ND","IENS"))="" ; IENS for target ITEM entries
S SEQMX=0 ; SEQUENCE maximum
; iterate through results, find target items
S Y="" F S Y=$O(PSBORIG(101.01,Y)) Q:Y="" D
. S X=+$G(PSBORIG(101.01,Y,3,"E")) S:X>SEQMX SEQMX=X ; highest SEQUENCE value
. S X=$G(PSBORIG(101.01,Y,.01,"E"))
. F J="1ST","2ND" S:X=ITM(J) ITM(J,"IENS")=Y ; target IEN
;
I (ITM("1ST","IENS")="")!(ITM("2ND","IENS")="") D Q ; must have IEN for both targets
. D MES^XPDUTL("missing IEN for target item(s)")
. F J="1ST","2ND" I ITM(J,"IENS")="" D MES^XPDUTL("IEN for "_ITM(J)_" not found.")
. D MES^XPDUTL("No update made by "_$T(+0)_" post-init")
;
; if both ITEM entries have SEQUENCE numbers, and the 2nd is greater than the 1st, no action needed
K Y F J="1ST","2ND" S Y(J)=$G(PSBORIG(101.01,ITM(J,"IENS"),3,"E"))
I Y("1ST"),Y("2ND"),Y("2ND")>Y("1ST") D Q
. D MES^XPDUTL("No SEQUENCE update needed."),MES^XPDUTL("No action taken by "_$T(+0)_" post-init.")
;
F J="1ST","2ND" D ; update the ITEM sequence
. N PSBFDA K PSBFMSG ; KILL old FileMan message array each time
. S SEQMX=SEQMX+10 ; add 10 to sequence maximum
. S PSBFDA(101.01,ITM(J,"IENS"),3)=SEQMX ; SEQUENCE field (#3)
. D UPDATE^DIE("","PSBFDA","","PSBFMSG")
. I $D(PSBFMSG("DIERR")) D
.. W !," FileMan error, updating SEQUENCE values" S G="PSBFMSG(""DIERR"")"
.. F S G=$Q(@G) Q:'(G["DIERR") D MES^XPDUTL(G_" = "_@G)
;
D BMES^XPDUTL($T(+0)_" post-init completed "_$$HTE^XLFDT($H))
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSB95P 2642 printed Apr 09, 2024@20:46:15 Page 2
PSB95P ;ASMR/hrubovcak - post-install for PSB patch 95 ;Jun 13, 2016 14:29:16
+1 ;;3.0;BAR CODE MED ADMIN;**95**;13 June 2016;Build 10
+2 ;
+3 ; fix for DE4250: modify PS EVSEND OR extended action protocol
+4 ; set sequence numbers for PSB BCBU RECEIVE and HMP XQOR EVENTS
+5 QUIT
+6 ;
EN ;
+1 DO DT^DICRW
DO MES^XPDUTL("updating PS EVSEND OR protocol")
+2 NEW DIC,G,ITM,J,PSBFMSG,PSBORIG,SEQMX,X,Y
+3 ; find PS EVSEND OR
SET DIC=101
SET X="PS EVSEND OR"
SET DIC(0)="Z"
DO ^DIC
+4 ; target protocol not found, write message, exit
+5 IF '(Y>0)
Begin DoDot:1
+6 DO MES^XPDUTL("*ERROR*: PS EVSEND OR protocol not found!")
+7 DO MES^XPDUTL("IRM support staff should contact eHMP or BCMA development.")
End DoDot:1
QUIT
+8 ;
+9 ; IEN for PS EVSEND OR is +Y
+10 ; external format, skip null values
DO GETS^DIQ(101,(+Y)_",","**","EN","PSBORIG","PSBFMSG")
+11 ; list FileMan error, exit
IF $DATA(PSBFMSG("DIERR"))
Begin DoDot:1
+12 WRITE !," FileMan error, retrieving ITEM values."
SET G="PSBFMSG(""DIERR"")"
+13 FOR
SET G=$QUERY(@G)
if '(G["DIERR")
QUIT
DO MES^XPDUTL(G_" = "_@G)
+14 DO MES^XPDUTL($TEXT(+0)_" post-init exited prematurely")
End DoDot:1
QUIT
+15 ;
+16 ; ITEM targets
SET ITM("1ST")="HMP XQOR EVENTS"
SET ITM("2ND")="PSB BCBU RECEIVE"
+17 ; IENS for target ITEM entries
SET (ITM("1ST","IENS"),ITM("2ND","IENS"))=""
+18 ; SEQUENCE maximum
SET SEQMX=0
+19 ; iterate through results, find target items
+20 SET Y=""
FOR
SET Y=$ORDER(PSBORIG(101.01,Y))
if Y=""
QUIT
Begin DoDot:1
+21 ; highest SEQUENCE value
SET X=+$GET(PSBORIG(101.01,Y,3,"E"))
if X>SEQMX
SET SEQMX=X
+22 SET X=$GET(PSBORIG(101.01,Y,.01,"E"))
+23 ; target IEN
FOR J="1ST","2ND"
if X=ITM(J)
SET ITM(J,"IENS")=Y
End DoDot:1
+24 ;
+25 ; must have IEN for both targets
IF (ITM("1ST","IENS")="")!(ITM("2ND","IENS")="")
Begin DoDot:1
+26 DO MES^XPDUTL("missing IEN for target item(s)")
+27 FOR J="1ST","2ND"
IF ITM(J,"IENS")=""
DO MES^XPDUTL("IEN for "_ITM(J)_" not found.")
+28 DO MES^XPDUTL("No update made by "_$TEXT(+0)_" post-init")
End DoDot:1
QUIT
+29 ;
+30 ; if both ITEM entries have SEQUENCE numbers, and the 2nd is greater than the 1st, no action needed
+31 KILL Y
FOR J="1ST","2ND"
SET Y(J)=$GET(PSBORIG(101.01,ITM(J,"IENS"),3,"E"))
+32 IF Y("1ST")
IF Y("2ND")
IF Y("2ND")>Y("1ST")
Begin DoDot:1
+33 DO MES^XPDUTL("No SEQUENCE update needed.")
DO MES^XPDUTL("No action taken by "_$TEXT(+0)_" post-init.")
End DoDot:1
QUIT
+34 ;
+35 ; update the ITEM sequence
FOR J="1ST","2ND"
Begin DoDot:1
+36 ; KILL old FileMan message array each time
NEW PSBFDA
KILL PSBFMSG
+37 ; add 10 to sequence maximum
SET SEQMX=SEQMX+10
+38 ; SEQUENCE field (#3)
SET PSBFDA(101.01,ITM(J,"IENS"),3)=SEQMX
+39 DO UPDATE^DIE("","PSBFDA","","PSBFMSG")
+40 IF $DATA(PSBFMSG("DIERR"))
Begin DoDot:2
+41 WRITE !," FileMan error, updating SEQUENCE values"
SET G="PSBFMSG(""DIERR"")"
+42 FOR
SET G=$QUERY(@G)
if '(G["DIERR")
QUIT
DO MES^XPDUTL(G_" = "_@G)
End DoDot:2
End DoDot:1
+43 ;
+44 DO BMES^XPDUTL($TEXT(+0)_" post-init completed "_$$HTE^XLFDT($HOROLOG))
+45 ;
+46 QUIT
+47 ;
