LRCAPAM0.m

LRCAPAM0 ;SLC/FHS - INTRO FOR MOVE WKLD DATA FROM 64.1 TO 67.9;10/14/91 08:15

 ;;5.2;LAB SERVICE;**81,141**;Sep 27, 1994

 D ^LRPARAM I '$P($G(LRLABKY),U,2) W !!?10,"You do not have the proper Security Key ...   Aborted ",!! G END

 L +^LRO(67.9):1 I '$T W !!?5,"Someone else is editing this file",!! G END

 S LINE="PHASE 1 OF LMIP DATA COLLECTION" W !?(IOM-$L(LINE))/2,LINE

 S LINE="Extract Monthly Workload Data From ^LRO(64.1 and placing" W !?(IOM-$L(LINE))/2,LINE

 S LINE="the Totals into ^LRO(67.9 in preparation for data" W !?(IOM-$L(LINE))/2,LINE

 S LINE="transmission to National Data Base" W !?(IOM-$L(LINE))/2,LINE,!!

 K DIC,LINE S (LRPRI,LRIN)="",DIC="^LRO(64.1,",DIC(0)="AQNEZ"

IN D ^DIC G:$E(X)=U!(Y<1) END I Y>0 S LRIN=+Y

 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 'LRPRI W !!?5,"Your Site is not defined in ^XMB(1,1,XUS) 17th Piece",!!,$C(7),!,"Process aborted ",! G END

DATE K %DT S %DT("A")="Begin with what date ",%DT="APEX" D ^%DT G:Y<1 END

 S LRDTS=Y

EDATE K %DT S %DT("A")="End with what date ",%DT="APEX" D ^%DT G:Y<1 END

 S LRDTE=Y S LREND=0

 I LRDTS>LRDTE S X=LRDTE,LRDTE=LRDTS,LRDTS=X

 S LRDTS=LRDTS-.9999,LRDTE=LRDTE+.9999

 S LRCHK=$O(^LRO(64.1,LRIN,1,LRDTS)) S:'LRCHK!(LRCHK>LRDTE) LREND=1 I $G(LREND) W !!?5,"No data for this date range ",!! G END

 W @IOF

 Q

END ;

 D END^LRCAPAM1 S LREND=1 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRCAPAM0   1395     printed  Apr 09, 2024@21:18:52                                                                                                                                                                                                    Page 2

LRCAPAM0  ;SLC/FHS - INTRO FOR MOVE WKLD DATA FROM 64.1 TO 67.9;10/14/91 08:15

 +1       ;;5.2;LAB SERVICE;**81,141**;Sep 27, 1994

 +2        DO ^LRPARAM

           IF '$PIECE($GET(LRLABKY),U,2)

               WRITE !!?10,"You do not have the proper Security Key ...   Aborted ",!!

               GOTO END

 +3        LOCK +^LRO(67.9):1

           IF '$TEST

               WRITE !!?5,"Someone else is editing this file",!!

               GOTO END

 +4        SET LINE="PHASE 1 OF LMIP DATA COLLECTION"

           WRITE !?(IOM-$LENGTH(LINE))/2,LINE

 +5        SET LINE="Extract Monthly Workload Data From ^LRO(64.1 and placing"

           WRITE !?(IOM-$LENGTH(LINE))/2,LINE

 +6        SET LINE="the Totals into ^LRO(67.9 in preparation for data"

           WRITE !?(IOM-$LENGTH(LINE))/2,LINE

 +7        SET LINE="transmission to National Data Base"

           WRITE !?(IOM-$LENGTH(LINE))/2,LINE,!!

 +8        KILL DIC,LINE

           SET (LRPRI,LRIN)=""

           SET DIC="^LRO(64.1,"

           SET DIC(0)="AQNEZ"

IN         DO ^DIC

           if $EXTRACT(X)=U!(Y<1)

               GOTO END

           IF Y>0

               SET LRIN=+Y

 +1        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)

 +2        IF 'LRPRI

               WRITE !!?5,"Your Site is not defined in ^XMB(1,1,XUS) 17th Piece",!!,$CHAR(7),!,"Process aborted ",!

               GOTO END

DATE       KILL %DT

           SET %DT("A")="Begin with what date "

           SET %DT="APEX"

           DO ^%DT

           if Y<1

               GOTO END

 +1        SET LRDTS=Y

EDATE      KILL %DT

           SET %DT("A")="End with what date "

           SET %DT="APEX"

           DO ^%DT

           if Y<1

               GOTO END

 +1        SET LRDTE=Y

           SET LREND=0

 +2        IF LRDTS>LRDTE

               SET X=LRDTE

               SET LRDTE=LRDTS

               SET LRDTS=X

 +3        SET LRDTS=LRDTS-.9999

           SET LRDTE=LRDTE+.9999

 +4        SET LRCHK=$ORDER(^LRO(64.1,LRIN,1,LRDTS))

           if 'LRCHK!(LRCHK>LRDTE)

               SET LREND=1

           IF $GET(LREND)

               WRITE !!?5,"No data for this date range ",!!

               GOTO END

 +5        WRITE @IOF

 +6        QUIT 

END       ;

 +1        DO END^LRCAPAM1

           SET LREND=1

           QUIT