- 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
- 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
