GECSRSTA ;WISC/RFJ-stack reports ;22 Dec 93
;;2.0;GCS;;MAR 14, 1995
N %DT,%I,DIR,DIRUT,GECSCODE,GECSDATE,GECSDESC,GECSEND,GECSFALL,GECSFLAG,GECSSSET,GECSSTAT,GECSSTRT,X,Y
; ask starting and ending transaction code
F D Q:$G(GECSFLAG)
. W !,"START with TRANSACTION CODE: FIRST// " R X:DTIME I '$T!(X["^") S GECSFLAG=1 Q
. I X["?" W !?2,"Select the starting TRANSACTION CODE. The TRANSACTION CODE is the two",!?2,"character code which identifies the document type." Q
. S GECSSTRT=X,GECSFLAG=1
I '$D(GECSSTRT) Q
K GECSFLAG
F D Q:$G(GECSFLAG)
. W !," END with TRANSACTION CODE: LAST// " R X:DTIME I '$T!(X["^") S GECSFLAG=1 Q
. I X["?" W !?2,"Select the ending TRANSACTION CODE." Q
. I X="" S X="z"
. I GECSSTRT]X W !?4,"Ending TRANSACTION CODE must follow starting TRANSACTION CODE." Q
. S GECSEND=X,GECSFLAG=1
I '$D(GECSEND) Q
;
; ask starting created date
S %DT="AEP",%DT("A")="Print documents created after DATE: ",%DT("B")="JAN 1,1993",%DT(0)=-DT W ! D ^%DT Q:Y<1 S GECSDATE=Y
;
; ask for status to print
S GECSSSET=$P(^DD(2100.1,3,0),"^",3)_"N:TRANSMITTED WITH NO CONFIRMATION MESSAGE RETURNED"
S DIR(0)="SO^"_GECSSSET,DIR("A")="Select STATUS(ES) to display"
K GECSSTAT
F W ! D ^DIR Q:Y="" D
. I $D(GECSSTAT(Y)) W !?5,"-- previously selected --" Q
. S GECSSTAT(Y)=""
I '$D(GECSSTAT) W !,"A STATUS was not selected !" D Q:'$G(GECSFALL)
. S XP=" Do you want to print ALL stack documents",XH=" Enter YES to print all documents, NO or '^' to exit."
. I $$YN^GECSUTIL(1)=1 S GECSFALL=1
W !!,"SELECTED STATUS(ES) to display:"
I $G(GECSFALL) W " ALL STATUS(ES)"
I '$G(GECSFALL) S Y="" F S Y=$O(GECSSTAT(Y)) Q:Y="" W !?10,$P($P(GECSSSET,Y_":",2),";")
;
W !!
S XP="Print DESCRIPTION of event" S GECSDESC=$$YN^GECSUTIL(2) Q:'GECSDESC
S XP="Print DOCUMENT code sheets" S GECSCODE=$$YN^GECSUTIL(2) Q:'GECSCODE
W !
S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
. S ZTDESC="GCS Stack File Report",ZTRTN="DQ^GECSRST1"
. S ZTSAVE("GECS*")="",ZTSAVE("ZTREQ")="@"
W !!,"<*> please wait <*>"
D DQ^GECSRST1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGECSRSTA 2186 printed Oct 16, 2024@17:57:10 Page 2
GECSRSTA ;WISC/RFJ-stack reports ;22 Dec 93
+1 ;;2.0;GCS;;MAR 14, 1995
+2 NEW %DT,%I,DIR,DIRUT,GECSCODE,GECSDATE,GECSDESC,GECSEND,GECSFALL,GECSFLAG,GECSSSET,GECSSTAT,GECSSTRT,X,Y
+3 ; ask starting and ending transaction code
+4 FOR
Begin DoDot:1
+5 WRITE !,"START with TRANSACTION CODE: FIRST// "
READ X:DTIME
IF '$TEST!(X["^")
SET GECSFLAG=1
QUIT
+6 IF X["?"
WRITE !?2,"Select the starting TRANSACTION CODE. The TRANSACTION CODE is the two",!?2,"character code which identifies the document type."
QUIT
+7 SET GECSSTRT=X
SET GECSFLAG=1
End DoDot:1
if $GET(GECSFLAG)
QUIT
+8 IF '$DATA(GECSSTRT)
QUIT
+9 KILL GECSFLAG
+10 FOR
Begin DoDot:1
+11 WRITE !," END with TRANSACTION CODE: LAST// "
READ X:DTIME
IF '$TEST!(X["^")
SET GECSFLAG=1
QUIT
+12 IF X["?"
WRITE !?2,"Select the ending TRANSACTION CODE."
QUIT
+13 IF X=""
SET X="z"
+14 IF GECSSTRT]X
WRITE !?4,"Ending TRANSACTION CODE must follow starting TRANSACTION CODE."
QUIT
+15 SET GECSEND=X
SET GECSFLAG=1
End DoDot:1
if $GET(GECSFLAG)
QUIT
+16 IF '$DATA(GECSEND)
QUIT
+17 ;
+18 ; ask starting created date
+19 SET %DT="AEP"
SET %DT("A")="Print documents created after DATE: "
SET %DT("B")="JAN 1,1993"
SET %DT(0)=-DT
WRITE !
DO ^%DT
if Y<1
QUIT
SET GECSDATE=Y
+20 ;
+21 ; ask for status to print
+22 SET GECSSSET=$PIECE(^DD(2100.1,3,0),"^",3)_"N:TRANSMITTED WITH NO CONFIRMATION MESSAGE RETURNED"
+23 SET DIR(0)="SO^"_GECSSSET
SET DIR("A")="Select STATUS(ES) to display"
+24 KILL GECSSTAT
+25 FOR
WRITE !
DO ^DIR
if Y=""
QUIT
Begin DoDot:1
+26 IF $DATA(GECSSTAT(Y))
WRITE !?5,"-- previously selected --"
QUIT
+27 SET GECSSTAT(Y)=""
End DoDot:1
+28 IF '$DATA(GECSSTAT)
WRITE !,"A STATUS was not selected !"
Begin DoDot:1
+29 SET XP=" Do you want to print ALL stack documents"
SET XH=" Enter YES to print all documents, NO or '^' to exit."
+30 IF $$YN^GECSUTIL(1)=1
SET GECSFALL=1
End DoDot:1
if '$GET(GECSFALL)
QUIT
+31 WRITE !!,"SELECTED STATUS(ES) to display:"
+32 IF $GET(GECSFALL)
WRITE " ALL STATUS(ES)"
+33 IF '$GET(GECSFALL)
SET Y=""
FOR
SET Y=$ORDER(GECSSTAT(Y))
if Y=""
QUIT
WRITE !?10,$PIECE($PIECE(GECSSSET,Y_":",2),";")
+34 ;
+35 WRITE !!
+36 SET XP="Print DESCRIPTION of event"
SET GECSDESC=$$YN^GECSUTIL(2)
if 'GECSDESC
QUIT
+37 SET XP="Print DOCUMENT code sheets"
SET GECSCODE=$$YN^GECSUTIL(2)
if 'GECSCODE
QUIT
+38 WRITE !
+39 SET %ZIS="Q"
DO ^%ZIS
if POP
QUIT
IF $DATA(IO("Q"))
Begin DoDot:1
+40 SET ZTDESC="GCS Stack File Report"
SET ZTRTN="DQ^GECSRST1"
+41 SET ZTSAVE("GECS*")=""
SET ZTSAVE("ZTREQ")="@"
End DoDot:1
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
QUIT
+42 WRITE !!,"<*> please wait <*>"
+43 DO DQ^GECSRST1
+44 QUIT
