LRCAPAMP ; IHS/DIR/AAB - PURGE AND RE RUN LMIP PHASE 1 ; [ 07/09/1998 9:21 AM ]
;;5.2;LR;**1002,1006**;SEP 01, 1998
;
;;5.2;LAB SERVICE;**82,163,201**;Sep 27, 1994
EN ;
L ^LRO(67.9):1 I '$T W !,$C(7),"Someone else is editing this file",! G END
S LRPRI=+$P($G(^XMB(1,1,"XUS")),U,17) I LRPRI,$L($G(^DIC(4,LRPRI,0)),U) S LRPRIN=$P(^(0),U)
I '$L($G(LRPRIN)) W !!?5,"Your Site is not defined in ^XMB(1,1,XUS) 17th Piece",!!,$C(7),!,"Process aborted ",! G END
F I=1:1 S TXT=$P($T(MSG+I),";",3) Q:TXT="END" W !?5,TXT
DIV K TXT,DIC S DIC("A")="Select Division to re-run: "
S DIC="^LRO(67.9,"_LRPRI_",1,",DIC(0)="AEQZNM" D ^DIC
G:Y<1 END S LRDIV=+Y
MONTH ;
S DIC=DIC_LRDIV_",1,",DIC("A")="Select Month to re-run: "
D ^DIC G:Y<1 END S LRMTH=Y
K DIR W !!?10,"Are you Sure you wish to delete [ "_$$FMTE^XLFDT($P(LRMTH,U,2),"1D")_" ] Data ",!!
S DIR(0)="Y" D ^DIR,STDRD G END:$G(LREND)!(Y'=1)
DEL ;
K DA,DR,DIE S DIE=DIC,DA=+LRMTH,DR=".01///@",DA(1)=LRDIV,DA(2)=LRPRI,DA(3)=67.9
W !!?10,"Purging ^LAH( Global ",! K ^LAH("LABWL")
W !!?5,"Deleting Data from ^LRO(67.9 ",!
D ^DIE W !!?10,"Data Purged",!!
LRO ;
W !!?10,"Resetting counted node in ^LRO(64.1 file ",!
S LRSPDT=$E($P(LRMTH,U,2),1,5),LRPDT=LRSPDT_"00"
F S LRPDT=$O(^LRO(64.1,LRDIV,1,LRPDT)) Q:LRPDT<1!($E(LRPDT,1,5)'=LRSPDT) D
. W "." S LRCC=0 F S LRCC=$O(^LRO(64.1,LRDIV,1,LRPDT,1,LRCC)) Q:LRCC<1 D
. . S LRCT=0 F S LRCT=$O(^LRO(64.1,LRDIV,1,LRPDT,1,LRCC,1,LRCT)) Q:LRCT'>0 I $D(^(LRCT,0))#2 S $P(^(0),U,20)=0
W !!?10,"FINISHED ",!!,$C(7)
END ;
L -^LRO(67.9)
W:$E(IOST)="P" @IOF D ^%ZISC
K DA,DIC,DIE,DIR,DTOUT,DUOUT,LRCC,LRCT,LRDIV,LREND,LRMTH,LRPDT,LRPRI
K LRPRIN,LRSPDT
Q
STDRD ;
S LREND=0 S:$D(DTOUT)!($D(DUOUT))!($D(DIRUT)) LREND=1
Q
MSG ;;
;;Note: If you Recompile any division's monthly LMIP data you must
;;recompile all divisions. Sites that are multi-divisional should ensure
;;that each division is recompiled and scanned again using Phase I
;;and Phase 2 options.
;; The ^LAH("LABWL") global used to build the Austin NDB LMIP message
;;will be deleted, therefore all previously compiled LMIP data will
;;be lost.
;; ***** CAUTION *****
;; CONTACT IRM SERVICE TO ENSURE JOURNAL SPACE IS AVAILABLE BEFORE
;;USING THIS OPTION. IF JOURNAL SPACE IS EXHAUSTED DURING THE
;;RECOMPILING PROCEDURE, YOUR COMPUTER SYSTEM MAY STOP
;; ALL DATA PROCESSING.
;;
;;
;;END
LRCAPAMP ; IHS/DIR/AAB - PURGE AND RE RUN LMIP PHASE 1 ; [ 07/09/1998 9:21 AM ]
+1 ;;5.2;LR;**1002,1006**;SEP 01, 1998
+2 ;
+3 ;;5.2;LAB SERVICE;**82,163,201**;Sep 27, 1994
EN ;
+1 LOCK ^LRO(67.9):1
IF '$TEST
WRITE !,$CHAR(7),"Someone else is editing this file",!
GOTO END
+2 SET LRPRI=+$PIECE($GET(^XMB(1,1,"XUS")),U,17)
IF LRPRI
IF $LENGTH($GET(^DIC(4,LRPRI,0)),U)
SET LRPRIN=$PIECE(^(0),U)
+3 IF '$LENGTH($GET(LRPRIN))
WRITE !!?5,"Your Site is not defined in ^XMB(1,1,XUS) 17th Piece",!!,$CHAR(7),!,"Process aborted ",!
GOTO END
+4 FOR I=1:1
SET TXT=$PIECE($TEXT(MSG+I),";",3)
IF TXT="END"
QUIT
WRITE !?5,TXT
DIV KILL TXT,DIC
SET DIC("A")="Select Division to re-run: "
+1 SET DIC="^LRO(67.9,"_LRPRI_",1,"
SET DIC(0)="AEQZNM"
DO ^DIC
+2 IF Y<1
GOTO END
SET LRDIV=+Y
MONTH ;
+1 SET DIC=DIC_LRDIV_",1,"
SET DIC("A")="Select Month to re-run: "
+2 DO ^DIC
IF Y<1
GOTO END
SET LRMTH=Y
+3 KILL DIR
WRITE !!?10,"Are you Sure you wish to delete [ "_$$FMTE^XLFDT($PIECE(LRMTH,U,2),"1D")_" ] Data ",!!
+4 SET DIR(0)="Y"
DO ^DIR
DO STDRD
IF $GET(LREND)!(Y'=1)
GOTO END
DEL ;
+1 KILL DA,DR,DIE
SET DIE=DIC
SET DA=+LRMTH
SET DR=".01///@"
SET DA(1)=LRDIV
SET DA(2)=LRPRI
SET DA(3)=67.9
+2 WRITE !!?10,"Purging ^LAH( Global ",!
KILL ^LAH("LABWL")
+3 WRITE !!?5,"Deleting Data from ^LRO(67.9 ",!
+4 DO ^DIE
WRITE !!?10,"Data Purged",!!
LRO ;
+1 WRITE !!?10,"Resetting counted node in ^LRO(64.1 file ",!
+2 SET LRSPDT=$EXTRACT($PIECE(LRMTH,U,2),1,5)
SET LRPDT=LRSPDT_"00"
+3 FOR
SET LRPDT=$ORDER(^LRO(64.1,LRDIV,1,LRPDT))
IF LRPDT<1!($EXTRACT(LRPDT,1,5)'=LRSPDT)
QUIT
Begin DoDot:1
+4 WRITE "."
SET LRCC=0
FOR
SET LRCC=$ORDER(^LRO(64.1,LRDIV,1,LRPDT,1,LRCC))
IF LRCC<1
QUIT
Begin DoDot:2
+5 SET LRCT=0
FOR
SET LRCT=$ORDER(^LRO(64.1,LRDIV,1,LRPDT,1,LRCC,1,LRCT))
IF LRCT'>0
QUIT
IF $DATA(^(LRCT,0))#2
SET $PIECE(^(0),U,20)=0
End DoDot:2
End DoDot:1
+6 WRITE !!?10,"FINISHED ",!!,$CHAR(7)
END ;
+1 LOCK -^LRO(67.9)
+2 IF $EXTRACT(IOST)="P"
WRITE @IOF
DO ^%ZISC
+3 KILL DA,DIC,DIE,DIR,DTOUT,DUOUT,LRCC,LRCT,LRDIV,LREND,LRMTH,LRPDT,LRPRI
+4 KILL LRPRIN,LRSPDT
+5 QUIT
STDRD ;
+1 SET LREND=0
IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
SET LREND=1
+2 QUIT
MSG ;;
+1 ;;Note: If you Recompile any division's monthly LMIP data you must
+2 ;;recompile all divisions. Sites that are multi-divisional should ensure
+3 ;;that each division is recompiled and scanned again using Phase I
+4 ;;and Phase 2 options.
+5 ;; The ^LAH("LABWL") global used to build the Austin NDB LMIP message
+6 ;;will be deleted, therefore all previously compiled LMIP data will
+7 ;;be lost.
+8 ;; ***** CAUTION *****
+9 ;; CONTACT IRM SERVICE TO ENSURE JOURNAL SPACE IS AVAILABLE BEFORE
+10 ;;USING THIS OPTION. IF JOURNAL SPACE IS EXHAUSTED DURING THE
+11 ;;RECOMPILING PROCEDURE, YOUR COMPUTER SYSTEM MAY STOP
+12 ;; ALL DATA PROCESSING.
+13 ;;
+14 ;;
+15 ;;END
