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
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGPOUT 1160 printed Oct 16, 2024@17:56:11 Page 2
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
+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
