GMRGPUTL ;HIRMFO/JH,RM-TEXT GENERATOR DATA SORT FOR OUTPUT ;9/1/95
;;3.0;Text Generator;;Jan 24, 1996
EN3 ; ENTRY TO RESULTS REPORTING MODULE
Q:'$D(DFN)!'$D(GMRGPDA)
S GMRG=$S($D(^GMR(124.3,+GMRGPDA,0)):^(0),1:"") G Q3:'GMRG D NOW^%DTC S GMRGPDT=%,GMRGRT=$P(GMRG,"^")_"^"_$S($D(^GMRD(124.2,+GMRG,0)):^(0),1:""),GMRGLIN("-")="",$P(GMRGLIN("-"),"-",IOM)="",GMRGOUT=0 D EN1
Q3 K GMRG,GMRGLIN,GMRGRT
Q
EN1 ;Enter here if classification is not known
S (GMRGG,GMRGC)=0,X=$S($D(^GMRD(124.2,+GMRGRT,0)):$P(^(0),"^",3),1:"") F GMRGA=0:0 S GMRGC=$O(^GMRD(124.2,"ATD",X,GMRGC)) Q:GMRGC'>0 S GMRGG=GMRGG+1,GMRGUCCH(GMRGG,GMRGC)=""
I GMRGG=1 S GMRGBAD=0,^TMP($J,"GMRGCPCH",GMRGG)=$O(GMRGUCCH(GMRGG,0)) G MES2
I GMRGG=0 W !,"NO PRINTABLE DATA" G Q1
S GMRGPCL=0,GMRGUCCH=GMRGG W !!,"The following are groupings of data that can be printed for this",!,"patient's ",$P(GMRGRT,"^",2),".",!
F GMRGG=0:0 S GMRGG=$O(GMRGUCCH(GMRGG)) Q:GMRGG'>0 D PRT1^GMRGPUT0 Q:GMRGOUT
S:GMRGOUT GMRGOUT=$S(GMRGOUT=1:0,1:1) Q:GMRGOUT
REPT W !!,"Select grouping(s) from 1-",GMRGUCCH R ": ",GMRGREQ:DTIME S:GMRGREQ="^"!(GMRGREQ="^^")!'$T GMRGOUT=1 I GMRGREQ=""!GMRGOUT G Q1
S GMRGBAD=0 F GMRGAA=1:1 S GMRGB=$P(GMRGREQ,",",GMRGAA) Q:GMRGB="" D CHECLAS^GMRGPUT0 Q:GMRGBAD
MES2 I GMRGBAD W !?5,$C(7),"Please enter numeric selection or up-arrow to quit.",!,?5,"Format: { 1 } or { 1,2,3,... } or { 2-7 } or { 2,3,7-9 } or { ^ } to quit" G REPT
S GMRGCJ=0 F GMRGAJ=0:0 S GMRGCJ=$O(^TMP($J,"GMRGCPCH",GMRGCJ)) Q:GMRGCJ'>0 S GMRGCLS=^TMP($J,"GMRGCPCH",GMRGCJ) D EN2 Q:GMRGOUT
Q1 K GMRGA,GMRGAJ,GMRGB,GMRGBAD,GMRGBEG,GMRGC,GMRGCJ,GMRGCLS,GMRGEND,GMRGG,GMRGPCL,GMRGREQ,GMRGUCCH,^TMP($J,"GMRGCPCH")
Q
EN2 ;Enter here if classification is known GMRGCLS=PTR TO 124.25 FILE.
Q:'$D(GMRGCLS) Q:GMRGCLS'>0 K ^TMP($J,"GMRGPLVL"),GMRGPCHC,GMRGUPCH S (GMRGC,GMRGPCL,GMRGG)=0
S X=$S($D(^GMRD(124.2,+GMRGRT,0)):$P(^(0),"^",3),1:"") F GMRGA=0:0 S GMRGC=$O(^GMRD(124.2,"ATD",X,GMRGCLS,GMRGC)) Q:GMRGC'>0 I $D(^GMR(124.3,GMRGPDA,1,"ALIST",GMRGC)) S GMRGG=GMRGG+1,GMRGPCHC(GMRGG,GMRGC)=""
I GMRGG=0 W !,"NO PRINTABLE ",$S($D(^GMRD(124.25,GMRGCLS,0)):$P(^(0),"^")_" ",1:""),"DATA" Q
W !!,"Below is a list of ",$S($D(^GMRD(124.25,GMRGCLS,0)):$P(^(0),"^")_" ",1:""),"entries to print",!
F GMRGA=0:0 S GMRGA=$O(GMRGPCHC(GMRGA)) Q:GMRGA'>0 D PRT2^GMRGPUT0 Q:GMRGOUT
S:GMRGOUT GMRGOUT=$S(GMRGOUT=1:0,1:1) Q:GMRGOUT
PROMP W !!,"Select entries from above list from 1-",GMRGG R ": ",GMRGREQ:DTIME S:GMRGREQ="^"!(GMRGREQ="^^")!'$T GMRGOUT=1 G Q2:GMRGREQ=""!GMRGOUT
S GMRGBAD=0 F GMRGAA=1:1 S GMRGB=$P(GMRGREQ,",",GMRGAA) Q:GMRGB="" D CHKREQ^GMRGPUT0 Q:GMRGBAD
MES1 I GMRGBAD W !?2,$C(7),"Please enter numeric selection or up-arrow to quit.",!,?5,"Format: { 1 } or { 1,2,3,... } or { 2-7 } or { 2,3,7-9 } or { ^ } to Quit" G PROMP
W !!,"This Job may be Queued to print to another device,",!,"freeing your terminal for other use.",!
DEV S %ZIS="Q" D ^%ZIS G Q2:POP I $E(IOST)="P",'$D(IO("Q")) D ^%ZISC W !,"YOU MUST QUEUE A REPORT BEFORE SENDING IT TO A PRINTER!!" G DEV
G:'$D(IO("Q")) TASK S ZION=ION,ZTSAVE("^TMP($J,")="",ZTSAVE("GMRGCJ")="",ZTSAVE("GMRGAA")="",ZTSAVE("GMRGCLS")="",ZTSAVE("GMRGPDA")=""
S ZTSAVE("GMRGA")="",ZTSAVE("GMRGLIN(")="",ZTSAVE("GMRGPDT")="",ZTSAVE("GMRGOUT")="",ZTSAVE("GMRGRT")="",ZTSAVE("DFN")="",ZTDESC="GMRG Care Plan Print",ZTRTN="TASK^GMRGPUTL" D ^%ZTLOAD K IO("Q"),ZTSAVE D ^%ZISC G Q2
TASK F GMRGAA=0:0 S GMRGAA=$O(^TMP($J,"GMRGUPCH",GMRGAA)) Q:GMRGAA'>0 S GMRGA=^(GMRGAA) I GMRGA>0 S GMRGPAR(0)="1^0^0^"_GMRGCLS,GMRGPAR=GMRGA D EN1^GMRGPNBL
;
D DEM^VADPT,INP^VADPT
U IO D EN1^GMRGPOUT ;Send Data To Selected Output Device.
D KVAR^VADPT K VA
;
Q2 K %ZIS,GMRGA,GMRGAA,GMRGB,GMRGBAD,GMRGBEG,GMRGC,GMRGEND,GMRGG,GMRGH,GMRGHH,GMRGI,GMRGJ,GMRGPCL,GMRGPCHC,GMRGREQ
K GMRGUPCH,^TMP($J,"GMRGUPCH"),^TMP($J,"GMRGNAR"),^TMP($J,"GMRGPLVL")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGPUTL 3876 printed Oct 16, 2024@17:56:14 Page 2
GMRGPUTL ;HIRMFO/JH,RM-TEXT GENERATOR DATA SORT FOR OUTPUT ;9/1/95
+1 ;;3.0;Text Generator;;Jan 24, 1996
EN3 ; ENTRY TO RESULTS REPORTING MODULE
+1 if '$DATA(DFN)!'$DATA(GMRGPDA)
QUIT
+2 SET GMRG=$SELECT($DATA(^GMR(124.3,+GMRGPDA,0)):^(0),1:"")
if 'GMRG
GOTO Q3
DO NOW^%DTC
SET GMRGPDT=%
SET GMRGRT=$PIECE(GMRG,"^")_"^"_$SELECT($DATA(^GMRD(124.2,+GMRG,0)):^(0),1:"")
SET GMRGLIN("-")=""
SET $PIECE(GMRGLIN("-"),"-",IOM)=""
SET GMRGOUT=0
DO EN1
Q3 KILL GMRG,GMRGLIN,GMRGRT
+1 QUIT
EN1 ;Enter here if classification is not known
+1 SET (GMRGG,GMRGC)=0
SET X=$SELECT($DATA(^GMRD(124.2,+GMRGRT,0)):$PIECE(^(0),"^",3),1:"")
FOR GMRGA=0:0
SET GMRGC=$ORDER(^GMRD(124.2,"ATD",X,GMRGC))
if GMRGC'>0
QUIT
SET GMRGG=GMRGG+1
SET GMRGUCCH(GMRGG,GMRGC)=""
+2 IF GMRGG=1
SET GMRGBAD=0
SET ^TMP($JOB,"GMRGCPCH",GMRGG)=$ORDER(GMRGUCCH(GMRGG,0))
GOTO MES2
+3 IF GMRGG=0
WRITE !,"NO PRINTABLE DATA"
GOTO Q1
+4 SET GMRGPCL=0
SET GMRGUCCH=GMRGG
WRITE !!,"The following are groupings of data that can be printed for this",!,"patient's ",$PIECE(GMRGRT,"^",2),".",!
+5 FOR GMRGG=0:0
SET GMRGG=$ORDER(GMRGUCCH(GMRGG))
if GMRGG'>0
QUIT
DO PRT1^GMRGPUT0
if GMRGOUT
QUIT
+6 if GMRGOUT
SET GMRGOUT=$SELECT(GMRGOUT=1:0,1:1)
if GMRGOUT
QUIT
REPT WRITE !!,"Select grouping(s) from 1-",GMRGUCCH
READ ": ",GMRGREQ:DTIME
if GMRGREQ="^"!(GMRGREQ="^^")!'$TEST
SET GMRGOUT=1
IF GMRGREQ=""!GMRGOUT
GOTO Q1
+1 SET GMRGBAD=0
FOR GMRGAA=1:1
SET GMRGB=$PIECE(GMRGREQ,",",GMRGAA)
if GMRGB=""
QUIT
DO CHECLAS^GMRGPUT0
if GMRGBAD
QUIT
MES2 IF GMRGBAD
WRITE !?5,$CHAR(7),"Please enter numeric selection or up-arrow to quit.",!,?5,"Format: { 1 } or { 1,2,3,... } or { 2-7 } or { 2,3,7-9 } or { ^ } to quit"
GOTO REPT
+1 SET GMRGCJ=0
FOR GMRGAJ=0:0
SET GMRGCJ=$ORDER(^TMP($JOB,"GMRGCPCH",GMRGCJ))
if GMRGCJ'>0
QUIT
SET GMRGCLS=^TMP($JOB,"GMRGCPCH",GMRGCJ)
DO EN2
if GMRGOUT
QUIT
Q1 KILL GMRGA,GMRGAJ,GMRGB,GMRGBAD,GMRGBEG,GMRGC,GMRGCJ,GMRGCLS,GMRGEND,GMRGG,GMRGPCL,GMRGREQ,GMRGUCCH,^TMP($JOB,"GMRGCPCH")
+1 QUIT
EN2 ;Enter here if classification is known GMRGCLS=PTR TO 124.25 FILE.
+1 if '$DATA(GMRGCLS)
QUIT
if GMRGCLS'>0
QUIT
KILL ^TMP($JOB,"GMRGPLVL"),GMRGPCHC,GMRGUPCH
SET (GMRGC,GMRGPCL,GMRGG)=0
+2 SET X=$SELECT($DATA(^GMRD(124.2,+GMRGRT,0)):$PIECE(^(0),"^",3),1:"")
FOR GMRGA=0:0
SET GMRGC=$ORDER(^GMRD(124.2,"ATD",X,GMRGCLS,GMRGC))
if GMRGC'>0
QUIT
IF $DATA(^GMR(124.3,GMRGPDA,1,"ALIST",GMRGC))
SET GMRGG=GMRGG+1
SET GMRGPCHC(GMRGG,GMRGC)=""
+3 IF GMRGG=0
WRITE !,"NO PRINTABLE ",$SELECT($DATA(^GMRD(124.25,GMRGCLS,0)):$PIECE(^(0),"^")_" ",1:""),"DATA"
QUIT
+4 WRITE !!,"Below is a list of ",$SELECT($DATA(^GMRD(124.25,GMRGCLS,0)):$PIECE(^(0),"^")_" ",1:""),"entries to print",!
+5 FOR GMRGA=0:0
SET GMRGA=$ORDER(GMRGPCHC(GMRGA))
if GMRGA'>0
QUIT
DO PRT2^GMRGPUT0
if GMRGOUT
QUIT
+6 if GMRGOUT
SET GMRGOUT=$SELECT(GMRGOUT=1:0,1:1)
if GMRGOUT
QUIT
PROMP WRITE !!,"Select entries from above list from 1-",GMRGG
READ ": ",GMRGREQ:DTIME
if GMRGREQ="^"!(GMRGREQ="^^")!'$TEST
SET GMRGOUT=1
if GMRGREQ=""!GMRGOUT
GOTO Q2
+1 SET GMRGBAD=0
FOR GMRGAA=1:1
SET GMRGB=$PIECE(GMRGREQ,",",GMRGAA)
if GMRGB=""
QUIT
DO CHKREQ^GMRGPUT0
if GMRGBAD
QUIT
MES1 IF GMRGBAD
WRITE !?2,$CHAR(7),"Please enter numeric selection or up-arrow to quit.",!,?5,"Format: { 1 } or { 1,2,3,... } or { 2-7 } or { 2,3,7-9 } or { ^ } to Quit"
GOTO PROMP
+1 WRITE !!,"This Job may be Queued to print to another device,",!,"freeing your terminal for other use.",!
DEV SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO Q2
IF $EXTRACT(IOST)="P"
IF '$DATA(IO("Q"))
DO ^%ZISC
WRITE !,"YOU MUST QUEUE A REPORT BEFORE SENDING IT TO A PRINTER!!"
GOTO DEV
+1 if '$DATA(IO("Q"))
GOTO TASK
SET ZION=ION
SET ZTSAVE("^TMP($J,")=""
SET ZTSAVE("GMRGCJ")=""
SET ZTSAVE("GMRGAA")=""
SET ZTSAVE("GMRGCLS")=""
SET ZTSAVE("GMRGPDA")=""
+2 SET ZTSAVE("GMRGA")=""
SET ZTSAVE("GMRGLIN(")=""
SET ZTSAVE("GMRGPDT")=""
SET ZTSAVE("GMRGOUT")=""
SET ZTSAVE("GMRGRT")=""
SET ZTSAVE("DFN")=""
SET ZTDESC="GMRG Care Plan Print"
SET ZTRTN="TASK^GMRGPUTL"
DO ^%ZTLOAD
KILL IO("Q"),ZTSAVE
DO ^%ZISC
GOTO Q2
TASK FOR GMRGAA=0:0
SET GMRGAA=$ORDER(^TMP($JOB,"GMRGUPCH",GMRGAA))
if GMRGAA'>0
QUIT
SET GMRGA=^(GMRGAA)
IF GMRGA>0
SET GMRGPAR(0)="1^0^0^"_GMRGCLS
SET GMRGPAR=GMRGA
DO EN1^GMRGPNBL
+1 ;
+2 DO DEM^VADPT
DO INP^VADPT
+3 ;Send Data To Selected Output Device.
USE IO
DO EN1^GMRGPOUT
+4 DO KVAR^VADPT
KILL VA
+5 ;
Q2 KILL %ZIS,GMRGA,GMRGAA,GMRGB,GMRGBAD,GMRGBEG,GMRGC,GMRGEND,GMRGG,GMRGH,GMRGHH,GMRGI,GMRGJ,GMRGPCL,GMRGPCHC,GMRGREQ
+1 KILL GMRGUPCH,^TMP($JOB,"GMRGUPCH"),^TMP($JOB,"GMRGNAR"),^TMP($JOB,"GMRGPLVL")
+2 QUIT
