LR334P ;DALOI/FHS - LR*5.2*334 POST INSTALL ROUTINE;31-AUG-2001
;;5.2;LAB SERVICE;**334**;Sep 27, 1994;Build 12
;Resolve preinstall data saved in XTMP("LR334",FILE#,IEN,FIELD)=Free Text -
EN ;
Q:'$D(XPDNM)
DD ;Purge .001 from installed files
F LRDA=64.2,64.3,64.061,64.062,95.3,95.31 D
. N DA,DIK
. S DA(1)=LRDA,DA=.001,DIK="^DD("_LRDA_","
. D ^DIK
N LRGLB,LRFDA,LRDATA
I '$G(^XTMP("LR334",1,0)) D Q
. D BMES^LR334("ERROR CONDITION - Preinstall historical data maybe incomplete.")
. D BMES^LR334("Post-Install repointing process aborted.")
S LRGLB="^XTMP(""LR334"",2)",LRCNT=0,LRFILE=""
K LRFDA
LOOP ;Loop through historical data and restore file
F S LRGLB=$Q(@LRGLB) Q:$QS(LRGLB,1)'="LR334" Q:'$QS(LRGLB,2) D
. I $G(LRFILE)'=$QS(LRGLB,2) D
. . S LRFILE=$QS(LRGLB,2) D BMES^LR334("Processing data for File/Subfile #"_LRFILE)
. S LRIEN=$QS(LRGLB,3),LRFLD=$QS(LRGLB,4),LRDATA=@LRGLB,LRCNT=$G(LRCNT)+1
. Q:$S('$G(LRIEN):1,'LRFLD:1,'$L(LRDATA):1,1:0)
. I LRFILE=64.2 D
. . N LR642,ERR
. . S LR642=$G(^XTMP("LR334",LRFILE,LRIEN,1))
. . S LRIEN=$$FIND1^DIC(LRFILE,"","XO",LR642_" ","C","","ERR")
. . I '$G(LRIEN) K LRIEN Q
. . S LRIEN=LRIEN_","
. Q:'$G(LRIEN)
. I LRFILE=64.2,LRFLD=1 Q
. S LRFDA(LRCNT,LRFILE,LRIEN,LRFLD)=LRDATA
. I LRCNT#200=0 W "."
. I $G(LRDBUG)=2 W "LRFDA("_LRCNT_","_LRFILE_","_LRIEN_","_LRFLD_") = "_@LRGLB,! Q
. K LRERR
. D FILE^DIE("KSE","LRFDA("_LRCNT_")","LRERR")
. I $D(LRERR) D ERR Q
. K LRFDA(LRCNT)
. I '$G(LRDBUG) K ^XTMP("LR334",LRFILE,LRIEN,LRFLD)
. S $P(^XTMP("LR334",1,0),U,3)=LRCNT
. S ^XTMP("LR334",1,LRFILE)=LRIEN
D BMES^LR334("Historical data restored")
D
. N LRIEN
. S LRIEN="" F S LRIEN=$O(^XTMP("LR334",64.2,LRIEN)) Q:LRIEN="" D
. . Q:$O(^XTMP("LR334",64.2,LRIEN,1))
. . K ^XTMP("LR334",64.2,LRIEN)
D MESLMI
Q
ERR ;Record data update error
W !,"ERROR" S ^XTMP("LR334","LRERR",LRCNT)=LRFILE_U_LRIEN_U_LRFLD_U_LRDATA
K LRFDA(LRCNT)
Q
MESLMI ; Notify LIM patch is installed.
N XQA,XQAMSG
D BMES^LR334("Sending install completion alert to mail group G.LMI")
;
S XQAMSG="Installation of patch "_$G(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($H)
S XQA("G.LMI")=""
D SETUP^XQALERT
;
S XQAMSG="LIM: Review description for "_$G(XPDNM,"Unknown patch")_" use KIDS:Utilities:Build File Print"
S XQA("G.LMI")=""
D SETUP^XQALERT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR334P 2393 printed Nov 22, 2024@17:13:57 Page 2
LR334P ;DALOI/FHS - LR*5.2*334 POST INSTALL ROUTINE;31-AUG-2001
+1 ;;5.2;LAB SERVICE;**334**;Sep 27, 1994;Build 12
+2 ;Resolve preinstall data saved in XTMP("LR334",FILE#,IEN,FIELD)=Free Text -
EN ;
+1 if '$DATA(XPDNM)
QUIT
DD ;Purge .001 from installed files
+1 FOR LRDA=64.2,64.3,64.061,64.062,95.3,95.31
Begin DoDot:1
+2 NEW DA,DIK
+3 SET DA(1)=LRDA
SET DA=.001
SET DIK="^DD("_LRDA_","
+4 DO ^DIK
End DoDot:1
+5 NEW LRGLB,LRFDA,LRDATA
+6 IF '$GET(^XTMP("LR334",1,0))
Begin DoDot:1
+7 DO BMES^LR334("ERROR CONDITION - Preinstall historical data maybe incomplete.")
+8 DO BMES^LR334("Post-Install repointing process aborted.")
End DoDot:1
QUIT
+9 SET LRGLB="^XTMP(""LR334"",2)"
SET LRCNT=0
SET LRFILE=""
+10 KILL LRFDA
LOOP ;Loop through historical data and restore file
+1 FOR
SET LRGLB=$QUERY(@LRGLB)
if $QSUBSCRIPT(LRGLB,1)'="LR334"
QUIT
if '$QSUBSCRIPT(LRGLB,2)
QUIT
Begin DoDot:1
+2 IF $GET(LRFILE)'=$QSUBSCRIPT(LRGLB,2)
Begin DoDot:2
+3 SET LRFILE=$QSUBSCRIPT(LRGLB,2)
DO BMES^LR334("Processing data for File/Subfile #"_LRFILE)
End DoDot:2
+4 SET LRIEN=$QSUBSCRIPT(LRGLB,3)
SET LRFLD=$QSUBSCRIPT(LRGLB,4)
SET LRDATA=@LRGLB
SET LRCNT=$GET(LRCNT)+1
+5 if $SELECT('$GET(LRIEN)
QUIT
+6 IF LRFILE=64.2
Begin DoDot:2
+7 NEW LR642,ERR
+8 SET LR642=$GET(^XTMP("LR334",LRFILE,LRIEN,1))
+9 SET LRIEN=$$FIND1^DIC(LRFILE,"","XO",LR642_" ","C","","ERR")
+10 IF '$GET(LRIEN)
KILL LRIEN
QUIT
+11 SET LRIEN=LRIEN_","
End DoDot:2
+12 if '$GET(LRIEN)
QUIT
+13 IF LRFILE=64.2
IF LRFLD=1
QUIT
+14 SET LRFDA(LRCNT,LRFILE,LRIEN,LRFLD)=LRDATA
+15 IF LRCNT#200=0
WRITE "."
+16 IF $GET(LRDBUG)=2
WRITE "LRFDA("_LRCNT_","_LRFILE_","_LRIEN_","_LRFLD_") = "_@LRGLB,!
QUIT
+17 KILL LRERR
+18 DO FILE^DIE("KSE","LRFDA("_LRCNT_")","LRERR")
+19 IF $DATA(LRERR)
DO ERR
QUIT
+20 KILL LRFDA(LRCNT)
+21 IF '$GET(LRDBUG)
KILL ^XTMP("LR334",LRFILE,LRIEN,LRFLD)
+22 SET $PIECE(^XTMP("LR334",1,0),U,3)=LRCNT
+23 SET ^XTMP("LR334",1,LRFILE)=LRIEN
End DoDot:1
+24 DO BMES^LR334("Historical data restored")
+25 Begin DoDot:1
+26 NEW LRIEN
+27 SET LRIEN=""
FOR
SET LRIEN=$ORDER(^XTMP("LR334",64.2,LRIEN))
if LRIEN=""
QUIT
Begin DoDot:2
+28 if $ORDER(^XTMP("LR334",64.2,LRIEN,1))
QUIT
+29 KILL ^XTMP("LR334",64.2,LRIEN)
End DoDot:2
End DoDot:1
+30 DO MESLMI
+31 QUIT
ERR ;Record data update error
+1 WRITE !,"ERROR"
SET ^XTMP("LR334","LRERR",LRCNT)=LRFILE_U_LRIEN_U_LRFLD_U_LRDATA
+2 KILL LRFDA(LRCNT)
+3 QUIT
MESLMI ; Notify LIM patch is installed.
+1 NEW XQA,XQAMSG
+2 DO BMES^LR334("Sending install completion alert to mail group G.LMI")
+3 ;
+4 SET XQAMSG="Installation of patch "_$GET(XPDNM,"Unknown patch")_" completed on "_$$HTE^XLFDT($HOROLOG)
+5 SET XQA("G.LMI")=""
+6 DO SETUP^XQALERT
+7 ;
+8 SET XQAMSG="LIM: Review description for "_$GET(XPDNM,"Unknown patch")_" use KIDS:Utilities:Build File Print"
+9 SET XQA("G.LMI")=""
+10 DO SETUP^XQALERT
+11 QUIT
