- 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 Mar 13, 2025@21:00:07 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
