QAQAHOC1 ;HISC/DAD-AD HOC REPORTS: SORT/PRINT SELECTION ;3/23/94 12:22
;;1.7;QM Integration Module;**1**;07/25/1995
ENASK ; *** Prompt user for sort/print fields
S QAQNEXT=0 I QAQSEQ>QAQMAXOP(QAQTYPE) W !!?3,"Maximum of ",QAQMAXOP(QAQTYPE)," ",QAQTYPE(0)," fields reached. ",*7 R QA:QAQDTIME S QAQNEXT=1 Q
S X=$S($G(QAQMHDR)]"":$E(QAQMHDR,1,45)_" ",1:"")_"Ad Hoc Report Generator"
W @IOF I $G(QAQMHDR)'="@" S Y=$L(X),X(1)="",$P(X(1),"=",70-Y/2)=" ",X(2)=" ",$P(X(2),"=",70-Y/2)="" W " ",X(1),X,X(2)
D LIST W !!?3,QAQTYPE(1)," selection # ",QAQSEQ," : " R QAQSELOP:DTIME S:'$T QAQSELOP="^"
I (QAQSEQ=1)&(QAQSELOP="") D G:QAQNONE=2 ENASK Q:QAQNEXT
NOTHING . S QAQNONE=2
. W *7,!!?3,"You have not selected any "
. W $S(QAQNUMOP("S")'>0:"sort or ",1:""),"print categories !!"
. W !?3,"Do you wish to exit the program"
. S %=1 D YN^DICN S QAQNONE=% I '% W !!?5,QAQYESNO G NOTHING
. Q:%=2
. S (QAQNEXT,QAQQUIT)=1 W !!?3,"No report will be produced." Q:%=-1
MACOUT . Q:QAQMOUTP'>0
. W !!?3,"You previously asked for macro output, do you still want it"
. S %=2 D YN^DICN I '% W !!?5,QAQYESNO G MACOUT
. D:%=1 EN2^QAQAHOC4
. Q
S:QAQSELOP="" QAQNEXT=1 S:$E(QAQSELOP)="^" (QAQNEXT,QAQQUIT)=1 Q:QAQNEXT!QAQQUIT
I $E(QAQSELOP)="[" D ^QAQAHOC3,HELP:QAQSELOP=-1 Q:QAQNEXT G:QAQMLOAD'>0 ENASK S QAQNEXT=1 Q
I QAQSELOP["," D S QAQNEXT='QAQAGIN Q:QAQNEXT G ENASK
. S QAQAGIN=0,QAQLIST=QAQSELOP
. I QAQSEQ>1 D S QAQAGIN=1 Q
.. W !!?3,QAQTYPE(1)," lists may only be entered at the"
.. W " first ",QAQTYPE(0)," selection prompt !! ",*7 R QA:QAQDTIME
.. Q
. I $L(QAQLIST,",")>QAQMAXOP(QAQTYPE) D S QAQAGIN=1 Q
.. W !!?3,"Too many ",QAQTYPE(0)," fields chosen !! ",*7 R QA:QAQDTIME
.. Q
. F QAQLST=1:1:$L(QAQSELOP,",") D Q:QAQAGIN
.. S QAQSELOP=$P(QAQLIST,",",QAQLST),QAQSEQ=QAQLST D CHECK
.. Q
. S QAQSEQ=QAQSEQ+1 Q:'QAQAGIN
. I QAQTYPE="S" K QAQBEGIN,QAQEND
. K QAQCHOSN,QAQOPTN(QAQTYPE) S QAQSEQ=1
. Q
S (QAQAGIN,QAQLST)=0 D CHECK G:QAQAGIN ENASK
Q
CHECK ; *** Check user's input
S QAQPREFX(0)=$S(QAQTYPE="S":"+-!#@'",1:"&!+#") D FIX^QAQAHOC2
S QAQPREFX(QAQTYPE,QAQSEQ)=QAQPREFX,QAQSUFFX(QAQTYPE,QAQSEQ)=QAQSUFFX
I QAQTYPE="P",$L(QAQPREFX)>1 S (QAQSELOP,QAQPREFX)=""
I QAQLST'>0 W " ",$P($G(QAQMENU(+QAQSELOP)),"^",2)
E W:QAQTYPE="S" !!?3,"Sort by: ",$P($G(QAQMENU(+QAQSELOP)),"^",2)
I $S(QAQSELOP<1:1,QAQSELOP>QAQMMAX:1,QAQSELOP'?1.N:1,$D(QAQMENU(QAQSELOP))[0:1,1:0) D HELP S QAQAGIN=1 Q
I $D(QAQCHOSN(QAQSELOP))#2 D S QAQAGIN=1 Q
. W *7,!!?3,"You have already chosen item ",QAQSELOP,", "
. W $P(QAQMENU(QAQSELOP),"^",2),","
. W !?3,"as a ",QAQTYPE(0)," field !! Please re-enter your selection. "
. R QA:QAQDTIME
. Q
I QAQTYPE="S",QAQMENU(QAQSELOP)'>0 W !!?3,"You are not allowed to sort by ",$P(QAQMENU(QAQSELOP),"^",2)," !! ",*7 R QA:QAQDTIME S QAQAGIN=1 Q
I QAQTYPE="S" S QAQDIR(0)=$P(QAQMENU(QAQSELOP),"^",4,99) D ^QAQAHOC2 I QAQQUIT!QAQNEXT S (QAQQUIT,QAQNEXT)=0 S QAQAGIN=1 Q
S X=$P(QAQMENU(QAQSELOP),"^",3),X=$P(X,"~")_QAQPREFX_$P(X,"~",2)
S X(0)=$P(X,";"),X(1)=$P($P(X,";"""),";",2,99),X("T")=$P(X,";""",2)
S QAQSUFFX(1)=$P(QAQSUFFX,";"""),QAQSUFFX("T")=$P(QAQSUFFX,";""",2)
S QAQ=X(0)_$S(QAQSUFFX(1)]"":QAQSUFFX(1),X(1)]"":";"_X(1),1:"")
S X=QAQ_$S(QAQSUFFX("T")]"":";"""_QAQSUFFX("T"),X("T")]"":";"""_X("T"),1:"")
S QAQOPTN(QAQTYPE,QAQSEQ,QAQSELOP)=X,QAQCHOSN(QAQSELOP)=""
Q
LIST ; *** Display the sort/print menus
W ! S QAQ=$Y,QAQMMAX(0)=QAQMMAX#2+QAQMMAX\2
F QA=1:1:QAQMMAX(0) S QAI=QA,QAQTAB=0 D S QAI=QA+QAQMMAX(0),QAQTAB=40 D I $Y>(IOSL+QAQ-4) S QAQ=$Y K DIR S DIR(0)="E" D ^DIR K DIR Q:Y'>0
. Q:$D(QAQMENU(QAI))[0
. W:QAQTAB=0 ! W ?QAQTAB,$S(QAQTYPE="P"!QAQMENU(QAI):$J(QAI,2),1:" ")
. W $S($D(QAQCHOSN(QAI)):" * ",1:" "),$P(QAQMENU(QAI),"^",2)
. Q
Q
HELP ; *** Display the sort/print help screens
I $E(QAQSELOP)'="?" W " ??",*7,!
E W @IOF
W !,"Select the ",$S(QAQSEQ=1:$S(QAQTYPE="S":"major",1:"first"),1:"next")," data element to ",$S(QAQTYPE="S":"sort by",1:"print"),". Maximum of ",QAQMAXOP(QAQTYPE)," ",QAQTYPE(0)," fields allowed."
W !,QAQBLURB,$S(QAQSEQ>1:", * means already chosen",1:""),".",!
D:$E(QAQSELOP)="?" EN^QAQAHOCH($S(QAQTYPE="S":"H1",1:"H2"))
R QA:(2*QAQDTIME)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAQAHOC1 4252 printed Dec 13, 2024@02:31:11 Page 2
QAQAHOC1 ;HISC/DAD-AD HOC REPORTS: SORT/PRINT SELECTION ;3/23/94 12:22
+1 ;;1.7;QM Integration Module;**1**;07/25/1995
ENASK ; *** Prompt user for sort/print fields
+1 SET QAQNEXT=0
IF QAQSEQ>QAQMAXOP(QAQTYPE)
WRITE !!?3,"Maximum of ",QAQMAXOP(QAQTYPE)," ",QAQTYPE(0)," fields reached. ",*7
READ QA:QAQDTIME
SET QAQNEXT=1
QUIT
+2 SET X=$SELECT($GET(QAQMHDR)]"":$EXTRACT(QAQMHDR,1,45)_" ",1:"")_"Ad Hoc Report Generator"
+3 WRITE @IOF
IF $GET(QAQMHDR)'="@"
SET Y=$LENGTH(X)
SET X(1)=""
SET $PIECE(X(1),"=",70-Y/2)=" "
SET X(2)=" "
SET $PIECE(X(2),"=",70-Y/2)=""
WRITE " ",X(1),X,X(2)
+4 DO LIST
WRITE !!?3,QAQTYPE(1)," selection # ",QAQSEQ," : "
READ QAQSELOP:DTIME
if '$TEST
SET QAQSELOP="^"
+5 IF (QAQSEQ=1)&(QAQSELOP="")
Begin DoDot:1
NOTHING SET QAQNONE=2
+1 WRITE *7,!!?3,"You have not selected any "
+2 WRITE $SELECT(QAQNUMOP("S")'>0:"sort or ",1:""),"print categories !!"
+3 WRITE !?3,"Do you wish to exit the program"
+4 SET %=1
DO YN^DICN
SET QAQNONE=%
IF '%
WRITE !!?5,QAQYESNO
GOTO NOTHING
+5 if %=2
QUIT
+6 SET (QAQNEXT,QAQQUIT)=1
WRITE !!?3,"No report will be produced."
if %=-1
QUIT
MACOUT if QAQMOUTP'>0
QUIT
+1 WRITE !!?3,"You previously asked for macro output, do you still want it"
+2 SET %=2
DO YN^DICN
IF '%
WRITE !!?5,QAQYESNO
GOTO MACOUT
+3 if %=1
DO EN2^QAQAHOC4
+4 QUIT
End DoDot:1
if QAQNONE=2
GOTO ENASK
if QAQNEXT
QUIT
+5 if QAQSELOP=""
SET QAQNEXT=1
if $EXTRACT(QAQSELOP)="^"
SET (QAQNEXT,QAQQUIT)=1
if QAQNEXT!QAQQUIT
QUIT
+6 IF $EXTRACT(QAQSELOP)="["
DO ^QAQAHOC3
if QAQSELOP=-1
DO HELP
if QAQNEXT
QUIT
if QAQMLOAD'>0
GOTO ENASK
SET QAQNEXT=1
QUIT
+7 IF QAQSELOP[","
Begin DoDot:1
+8 SET QAQAGIN=0
SET QAQLIST=QAQSELOP
+9 IF QAQSEQ>1
Begin DoDot:2
+10 WRITE !!?3,QAQTYPE(1)," lists may only be entered at the"
+11 WRITE " first ",QAQTYPE(0)," selection prompt !! ",*7
READ QA:QAQDTIME
+12 QUIT
End DoDot:2
SET QAQAGIN=1
QUIT
+13 IF $LENGTH(QAQLIST,",")>QAQMAXOP(QAQTYPE)
Begin DoDot:2
+14 WRITE !!?3,"Too many ",QAQTYPE(0)," fields chosen !! ",*7
READ QA:QAQDTIME
+15 QUIT
End DoDot:2
SET QAQAGIN=1
QUIT
+16 FOR QAQLST=1:1:$LENGTH(QAQSELOP,",")
Begin DoDot:2
+17 SET QAQSELOP=$PIECE(QAQLIST,",",QAQLST)
SET QAQSEQ=QAQLST
DO CHECK
+18 QUIT
End DoDot:2
if QAQAGIN
QUIT
+19 SET QAQSEQ=QAQSEQ+1
if 'QAQAGIN
QUIT
+20 IF QAQTYPE="S"
KILL QAQBEGIN,QAQEND
+21 KILL QAQCHOSN,QAQOPTN(QAQTYPE)
SET QAQSEQ=1
+22 QUIT
End DoDot:1
SET QAQNEXT='QAQAGIN
if QAQNEXT
QUIT
GOTO ENASK
+23 SET (QAQAGIN,QAQLST)=0
DO CHECK
if QAQAGIN
GOTO ENASK
+24 QUIT
CHECK ; *** Check user's input
+1 SET QAQPREFX(0)=$SELECT(QAQTYPE="S":"+-!#@'",1:"&!+#")
DO FIX^QAQAHOC2
+2 SET QAQPREFX(QAQTYPE,QAQSEQ)=QAQPREFX
SET QAQSUFFX(QAQTYPE,QAQSEQ)=QAQSUFFX
+3 IF QAQTYPE="P"
IF $LENGTH(QAQPREFX)>1
SET (QAQSELOP,QAQPREFX)=""
+4 IF QAQLST'>0
WRITE " ",$PIECE($GET(QAQMENU(+QAQSELOP)),"^",2)
+5 IF '$TEST
if QAQTYPE="S"
WRITE !!?3,"Sort by: ",$PIECE($GET(QAQMENU(+QAQSELOP)),"^",2)
+6 IF $SELECT(QAQSELOP<1:1,QAQSELOP>QAQMMAX:1,QAQSELOP'?1.N:1,$DATA(QAQMENU(QAQSELOP))[0:1,1:0)
DO HELP
SET QAQAGIN=1
QUIT
+7 IF $DATA(QAQCHOSN(QAQSELOP))#2
Begin DoDot:1
+8 WRITE *7,!!?3,"You have already chosen item ",QAQSELOP,", "
+9 WRITE $PIECE(QAQMENU(QAQSELOP),"^",2),","
+10 WRITE !?3,"as a ",QAQTYPE(0)," field !! Please re-enter your selection. "
+11 READ QA:QAQDTIME
+12 QUIT
End DoDot:1
SET QAQAGIN=1
QUIT
+13 IF QAQTYPE="S"
IF QAQMENU(QAQSELOP)'>0
WRITE !!?3,"You are not allowed to sort by ",$PIECE(QAQMENU(QAQSELOP),"^",2)," !! ",*7
READ QA:QAQDTIME
SET QAQAGIN=1
QUIT
+14 IF QAQTYPE="S"
SET QAQDIR(0)=$PIECE(QAQMENU(QAQSELOP),"^",4,99)
DO ^QAQAHOC2
IF QAQQUIT!QAQNEXT
SET (QAQQUIT,QAQNEXT)=0
SET QAQAGIN=1
QUIT
+15 SET X=$PIECE(QAQMENU(QAQSELOP),"^",3)
SET X=$PIECE(X,"~")_QAQPREFX_$PIECE(X,"~",2)
+16 SET X(0)=$PIECE(X,";")
SET X(1)=$PIECE($PIECE(X,";"""),";",2,99)
SET X("T")=$PIECE(X,";""",2)
+17 SET QAQSUFFX(1)=$PIECE(QAQSUFFX,";""")
SET QAQSUFFX("T")=$PIECE(QAQSUFFX,";""",2)
+18 SET QAQ=X(0)_$SELECT(QAQSUFFX(1)]"":QAQSUFFX(1),X(1)]"":";"_X(1),1:"")
+19 SET X=QAQ_$SELECT(QAQSUFFX("T")]"":";"""_QAQSUFFX("T"),X("T")]"":";"""_X("T"),1:"")
+20 SET QAQOPTN(QAQTYPE,QAQSEQ,QAQSELOP)=X
SET QAQCHOSN(QAQSELOP)=""
+21 QUIT
LIST ; *** Display the sort/print menus
+1 WRITE !
SET QAQ=$Y
SET QAQMMAX(0)=QAQMMAX#2+QAQMMAX\2
+2 FOR QA=1:1:QAQMMAX(0)
SET QAI=QA
SET QAQTAB=0
Begin DoDot:1
+3 if $DATA(QAQMENU(QAI))[0
QUIT
+4 if QAQTAB=0
WRITE !
WRITE ?QAQTAB,$SELECT(QAQTYPE="P"!QAQMENU(QAI):$JUSTIFY(QAI,2),1:" ")
+5 WRITE $SELECT($DATA(QAQCHOSN(QAI)):" * ",1:" "),$PIECE(QAQMENU(QAI),"^",2)
+6 QUIT
End DoDot:1
SET QAI=QA+QAQMMAX(0)
SET QAQTAB=40
Begin DoDot:1
End DoDot:1
IF $Y>(IOSL+QAQ-4)
SET QAQ=$Y
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
if Y'>0
QUIT
+7 QUIT
HELP ; *** Display the sort/print help screens
+1 IF $EXTRACT(QAQSELOP)'="?"
WRITE " ??",*7,!
+2 IF '$TEST
WRITE @IOF
+3 WRITE !,"Select the ",$SELECT(QAQSEQ=1:$SELECT(QAQTYPE="S":"major",1:"first"),1:"next")," data element to ",$SELECT(QAQTYPE="S":"sort by",1:"print"),". Maximum of ",QAQMAXOP(QAQTYPE)," ",QAQTYPE(0)," fields allowed."
+4 WRITE !,QAQBLURB,$SELECT(QAQSEQ>1:", * means already chosen",1:""),".",!
+5 if $EXTRACT(QAQSELOP)="?"
DO EN^QAQAHOCH($SELECT(QAQTYPE="S":"H1",1:"H2"))
+6 READ QA:(2*QAQDTIME)
+7 QUIT
