| 1 | LRCAPAMP ;DALISC/FHS - PURGE AND RE RUN LMIP PHASE 1
 | 
|---|
| 2 |  ;;5.2;LAB SERVICE;**82,163,201**;Sep 27, 1994
 | 
|---|
| 3 | EN ;
 | 
|---|
| 4 |  L ^LRO(67.9):1 I '$T W !,$C(7),"Someone else is editing this file",! G END
 | 
|---|
| 5 |  S LRPRI=+$P($G(^XMB(1,1,"XUS")),U,17) I LRPRI,$L($G(^DIC(4,LRPRI,0)),U) S LRPRIN=$P(^(0),U)
 | 
|---|
| 6 |  I '$L($G(LRPRIN)) W !!?5,"Your Site is not defined in ^XMB(1,1,XUS) 17th Piece",!!,$C(7),!,"Process aborted ",! G END
 | 
|---|
| 7 |  F I=1:1 S TXT=$P($T(MSG+I),";",3) Q:TXT="END"  W !?5,TXT
 | 
|---|
| 8 | DIV K TXT,DIC S DIC("A")="Select Division to re-run: "
 | 
|---|
| 9 |  S DIC="^LRO(67.9,"_LRPRI_",1,",DIC(0)="AEQZNM" D ^DIC
 | 
|---|
| 10 |  G:Y<1 END S LRDIV=+Y
 | 
|---|
| 11 | MONTH ;
 | 
|---|
| 12 |  S DIC=DIC_LRDIV_",1,",DIC("A")="Select Month to re-run: "
 | 
|---|
| 13 |  D ^DIC G:Y<1 END S LRMTH=Y
 | 
|---|
| 14 |  K DIR W !!?10,"Are you Sure you wish to delete [ "_$$FMTE^XLFDT($P(LRMTH,U,2),"1D")_" ] Data ",!!
 | 
|---|
| 15 |  S DIR(0)="Y" D ^DIR,STDRD G END:$G(LREND)!(Y'=1)
 | 
|---|
| 16 | DEL ;
 | 
|---|
| 17 |  K DA,DR,DIE S DIE=DIC,DA=+LRMTH,DR=".01///@",DA(1)=LRDIV,DA(2)=LRPRI,DA(3)=67.9
 | 
|---|
| 18 |  W !!?10,"Purging ^LAH( Global ",! K ^LAH("LABWL")
 | 
|---|
| 19 |  W !!?5,"Deleting Data from ^LRO(67.9 ",!
 | 
|---|
| 20 |  D ^DIE W !!?10,"Data Purged",!!
 | 
|---|
| 21 | LRO ;
 | 
|---|
| 22 |  W !!?10,"Resetting counted node in ^LRO(64.1 file ",!
 | 
|---|
| 23 |  S LRSPDT=$E($P(LRMTH,U,2),1,5),LRPDT=LRSPDT_"00"
 | 
|---|
| 24 |  F  S LRPDT=$O(^LRO(64.1,LRDIV,1,LRPDT)) Q:LRPDT<1!($E(LRPDT,1,5)'=LRSPDT)  D
 | 
|---|
| 25 |  . W "." S LRCC=0 F  S LRCC=$O(^LRO(64.1,LRDIV,1,LRPDT,1,LRCC)) Q:LRCC<1  D
 | 
|---|
| 26 |  . . 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
 | 
|---|
| 27 |  W !!?10,"FINISHED ",!!,$C(7)
 | 
|---|
| 28 | END ;
 | 
|---|
| 29 |  L -^LRO(67.9)
 | 
|---|
| 30 |  W:$E(IOST)="P" @IOF D ^%ZISC
 | 
|---|
| 31 |  K DA,DIC,DIE,DIR,DTOUT,DUOUT,LRCC,LRCT,LRDIV,LREND,LRMTH,LRPDT,LRPRI
 | 
|---|
| 32 |  K LRPRIN,LRSPDT
 | 
|---|
| 33 |  Q
 | 
|---|
| 34 | STDRD ;
 | 
|---|
| 35 |  S LREND=0 S:$D(DTOUT)!($D(DUOUT))!($D(DIRUT)) LREND=1
 | 
|---|
| 36 |  Q
 | 
|---|
| 37 | MSG ;;
 | 
|---|
| 38 |  ;;Note:  If you Recompile any division's monthly LMIP data you must
 | 
|---|
| 39 |  ;;recompile all divisions. Sites that are multi-divisional should ensure
 | 
|---|
| 40 |  ;;that each division is recompiled and scanned again using Phase I
 | 
|---|
| 41 |  ;;and Phase 2 options.
 | 
|---|
| 42 |  ;;  The ^LAH("LABWL") global used to build the Austin NDB LMIP message
 | 
|---|
| 43 |  ;;will be deleted, therefore all previously compiled LMIP data will
 | 
|---|
| 44 |  ;;be lost.
 | 
|---|
| 45 |  ;;                      ***** CAUTION *****
 | 
|---|
| 46 |  ;; CONTACT IRM SERVICE TO ENSURE JOURNAL SPACE IS AVAILABLE BEFORE
 | 
|---|
| 47 |  ;;USING THIS OPTION. IF JOURNAL SPACE IS EXHAUSTED DURING THE 
 | 
|---|
| 48 |  ;;RECOMPILING PROCEDURE, YOUR COMPUTER SYSTEM MAY STOP
 | 
|---|
| 49 |  ;;                  ALL DATA PROCESSING.
 | 
|---|
| 50 |  ;;
 | 
|---|
| 51 |  ;;
 | 
|---|
| 52 |  ;;END
 | 
|---|