- 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 Feb 18, 2025@23:29:44 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