GMRGPOUT.m

GMRGPOUT ;HIRMFO/JH,RM-TEXT GENERATOR CARE PLAN DATA OUTPUT ;9/1/95

 ;;3.0;Text Generator;;Jan 24, 1996

 ;

EN1 D NOW^%DTC S Y=% D D^DIQ S GMRGDAT=$P(Y,":",1,2),GMRG1SW=1,GMRGSP=0

 S (GMRGA,GMRGPAG)=0 F GMRGD=0:0 S GMRGA=$O(^TMP($J,"GMRGNAR",GMRGA)) Q:GMRGA'>0  D GMRIEN

 I $E(IOST)="C"&'GMRGOUT W !!,"Press return to continue " R X:DTIME I X="^^"!'$T S GMRGOUT=2

 S:GMRGOUT GMRGOUT=$S(GMRGOUT=1:0,1:1) K GMRG1SW,GMRGA,GMRGB,GMRGD,GMRGE,GMRGF,GMRGDAT,GMRGPAG,GMRGSP

 Q

GMRIEN S GMRGF=0 D HEADER F GMRGE=0:0 S GMRGF=$O(^TMP($J,"GMRGNAR",GMRGA,GMRGF)) Q:GMRGF'>0  D PRINT Q:GMRGOUT

 Q

PRINT W ! S GMRGSP=1,GMRGC=0 F GMRGB=1:1 S GMRGC=$O(^TMP($J,"GMRGNAR",GMRGA,GMRGF,GMRGC)) Q:GMRGC'>0  W !,^(GMRGC) D:$Y>(IOSL-3) HEADER Q:GMRGOUT

 Q

HEADER ;

 I 'GMRG1SW,$E(IOST)="C" W !!,"Press return to continue, '^' to stop print " R X:DTIME S:X="^"!(X="^^")!'$T GMRGOUT=$S(X="^":1,1:2) Q:GMRGOUT

 S:GMRG1SW GMRG1SW=0 S GMRGPAG=GMRGPAG+1

 W:GMRGPAG>1 @IOF W !,$P(VADM(1),"^"),"   ",$P(VADM(2),"^",2),?50,$P(VADM(3),"^",2)," (",$P(VADM(4),"^"),")   PAGE: ",GMRGPAG,!,GMRGDAT,?(IOM-$L($P(GMRGRT,"^",2))\2),$P(GMRGRT,"^",2),!,GMRGLIN("-"),! I GMRGSP="1" W !

 Q

GMRGPOUT  ;HIRMFO/JH,RM-TEXT GENERATOR CARE PLAN DATA OUTPUT ;9/1/95

 +1       ;;3.0;Text Generator;;Jan 24, 1996

 +2       ;

EN1        DO NOW^%DTC

           SET Y=%

           DO D^DIQ

           SET GMRGDAT=$PIECE(Y,":",1,2)

           SET GMRG1SW=1

           SET GMRGSP=0

 +1        SET (GMRGA,GMRGPAG)=0

           FOR GMRGD=0:0

               SET GMRGA=$ORDER(^TMP($JOB,"GMRGNAR",GMRGA))

               IF GMRGA'>0

                   QUIT 

               DO GMRIEN

 +2        IF $EXTRACT(IOST)="C"&'GMRGOUT

               WRITE !!,"Press return to continue "

               READ X:DTIME

               IF X="^^"!'$TEST

                   SET GMRGOUT=2

 +3        IF GMRGOUT

               SET GMRGOUT=$SELECT(GMRGOUT=1:0,1:1)

           KILL GMRG1SW,GMRGA,GMRGB,GMRGD,GMRGE,GMRGF,GMRGDAT,GMRGPAG,GMRGSP

 +4        QUIT 

GMRIEN     SET GMRGF=0

           DO HEADER

           FOR GMRGE=0:0

               SET GMRGF=$ORDER(^TMP($JOB,"GMRGNAR",GMRGA,GMRGF))

               IF GMRGF'>0

                   QUIT 

               DO PRINT

               IF GMRGOUT

                   QUIT 

 +1        QUIT 

PRINT      WRITE !

           SET GMRGSP=1

           SET GMRGC=0

           FOR GMRGB=1:1

               SET GMRGC=$ORDER(^TMP($JOB,"GMRGNAR",GMRGA,GMRGF,GMRGC))

               IF GMRGC'>0

                   QUIT 

               WRITE !,^(GMRGC)

               IF $Y>(IOSL-3)

                   DO HEADER

               IF GMRGOUT

                   QUIT 

 +1        QUIT 

HEADER    ;

 +1        IF 'GMRG1SW

               IF $EXTRACT(IOST)="C"

                   WRITE !!,"Press return to continue, '^' to stop print "

                   READ X:DTIME

                   IF X="^"!(X="^^")!'$TEST

                       SET GMRGOUT=$SELECT(X="^":1,1:2)

                   IF GMRGOUT

                       QUIT 

 +2        IF GMRG1SW

               SET GMRG1SW=0

           SET GMRGPAG=GMRGPAG+1

 +3        IF GMRGPAG>1

               WRITE @IOF

           WRITE !,$PIECE(VADM(1),"^"),"   ",$PIECE(VADM(2),"^",2),?50,$PIECE(VADM(3),"^",2)," (",$PIECE(VADM(4),"^"),")   PAGE: ",GMRGPAG,!,GMRGDAT,?(IOM-$LENGTH($PIECE(GMRGRT,"^",2))\2),$PIECE(GMRGRT,"^",2),!,GMRGLIN("-"),!

           IF GMRGSP="1"

               WRITE !

 +4        QUIT