APCLSRT ; IHS/CMI/LAB - IHS GETS SORT INFO FOR PCC REPORTS ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;SORT CONTROLLER FOR REPORTS
EN D CHKVARS^APCLSRT2
G:$D(APCLQUIT) EXIT
D MENU
EN1 D HEAD,CHOICE,EXIT
Q
CHKNAV ;check for navigation string for file and sort field
I '$D(^APCLSRT(X,4,APCLFILE)) W !,$C(7),$C(7),"Navigation not defined for the File! Notify programmer!",!! S APCLQUIT="" Q
S APCLNAV=$P(^APCLSRT(X,4,APCLFILE,0),U,2)
Q
;
HEAD ;
W:$D(IOF) @IOF
S APCLX="REPORT SORTING UTILITY" W !!?80-$L(APCLX)\2,APCLX K APCLX,APCLFORC
W !
W !,"The ",@APCLRVON,APCLRPT,@APCLRVOF
W " report can be sorted by one or more"
W !,"of the following attributes. "
W "'<<===' indicates a mandatory selection.",!
Q
F S X=$O(^APCLSRT("B",X)) Q:X="" F Y=0:0 S Y=$O(^APCLSRT("B",X,Y)) Q:'Y I $D(^APCLSRT(Y,2,"B",APCLPTMP)) D M1
W ! Q
CHOICE D M2
I (J-1)=1 S APCLZZ=1 G OK
W !!?6,"Your choice (1",$S((J-1)>1:"-"_(J-1),1:""),"): "
R APCLZZ:DTIME I '$T S APCLZZ=U
I APCLZZ=""!(APCLZZ[U) S APCLQUIT="" Q
I APCLZZ'?1N.2N!(APCLZZ>(J-1)) W !!?6,$C(7),"Type ",$S((J-1)>1:"a number from 1",1:"number 1: "),$S((J-1)>1:"-"_(J-1)_":",1:"") W ! G CHOICE
I APCLZZ,APCLZZ'>J G OK
G CHOICE
OK S Z=%APCL(APCLZZ),(X,APCLSNO)=+Z,APCLSNA=$P(Z,U,2),APCLCSTG=APCLCSTG_APCLZZ_U
K Z,%APCLB(X) W:(J-1)>1 " ",APCLSNA
OK1 I BY]"" S BY=BY_","
S APCLREC=^APCLSRT(X,0)
S APCLDIC=^DIC(APCLFILE,0,"GL")
D CHKNAV I $D(APCLQUIT) Q
K J
S BY=BY_APCLNAV
D @("S"_$P(APCLREC,U,2)_"^APCLSRT1")
K APCLNAV,APCLREC
I $D(APCLQUIT) Q
I $D(APCLFORC) K APCLFORC D PRINT Q
I BY["[" S BY="["_$P(BY,"[",2) S BY=$P(BY,"]")_"]" G PRINT
I I<2 D PRINT Q
W !!,"Within ",APCLSNA,", want to sort by another attribute"
S %=2 D YN^DICN
I %Y=U S APCLQUIT="" Q
I "Nn"[$E(%Y) D CHECK G:$D(APCLFORC) OK D PRINT Q
W !!! S APCLN=APCLN+1,I=I-1 G EN1
EXIT K X,J,Y,Z,%Y,APCLZ,APCLZZ,APCLDIC,APCLN,APCLPTMP,BY,FR,TO,FLDS,I,APCLQUIT,APCLFILE,APCLRPT,%,%DT,APCLDM,APCLI,APCLSET,BY1,BY2,DHD,DIC,DIOEND,DIR,DUOUT,B,P,APCLBEGD
K APCLSNO,APCLSNA,%APCL,%APCLB,APCLRVOF,APCLRVON,APCLTRM
K APCLX,APCLY,APCLMAND,APCLCSTG,APCLMANN,APCLMAN,APCLSRT,APCLCST,APCLTRM,APCLREC,APCLNAV,APCLFORC,APCLPS
D ^%ZISC
I '$D(ZTQUEUED) S IOP="HOME" D ^%ZIS
W:$D(IOF) @IOF
Q
M1 N Z
S Z=$O(^APCLSRT(Y,2,"B",APCLPTMP,"")),Z=^(Z)
S I=I+1,%APCLB(Y)=Y_U_X_U_Z
Q
M2 K %APCL S APCLZ=""
F J=1:1 S APCLZ=$O(%APCLB(APCLZ)) Q:'APCLZ S (%APCL(J),APCLSRT)=%APCLB(APCLZ),X=$P(APCLSRT,U,2),Y=$P(APCLSRT,U),Z=$P(APCLSRT,U,3) W:J#2 !?6 W:'(J#2) ?45 W $J(J,3),") ",X I Z W " <<===" S APCLMAND=J,APCLMANN=X,APCLMAN=Y_U_X
K APCLSRT,APCLZ
Q
TITLE ;
S DIR(0)="FO^2:60",DIR("A")="Please enter a TITLE for this report: ",DIR("B")="PATIENT LISTING",DIR("?")="Enter a narrative title that you want to see on this report" D ^DIR K DIR
I $D(DUOUT) S APCLQUIT="" Q
S DHD=X
Q
PRINT ;
D TITLE
Q:$D(APCLQUIT)
PRNT S DIC=APCLDIC
PRT1 S DIOEND="D EOR^APCLSRT"
DIP D EN1^DIP
Q
CHECK I APCLCSTG[(U_APCLMAND_U) Q
S APCLZZ=APCLMAND,APCLFORC="",APCLN=APCLN+1
W !!,$C(7),"You must also sort by"
Q
EOR ;
I $D(IOST),IOST["C-" W !!,"End of report. Strike <CR> to continue" R APCLX:300
W:$D(IOF) @IOF
Q
APCLSRT ; IHS/CMI/LAB - IHS GETS SORT INFO FOR PCC REPORTS ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;SORT CONTROLLER FOR REPORTS
EN DO CHKVARS^APCLSRT2
+1 IF $DATA(APCLQUIT)
GOTO EXIT
+2 DO MENU
EN1 DO HEAD
DO CHOICE
DO EXIT
+1 QUIT
CHKNAV ;check for navigation string for file and sort field
+1 IF '$DATA(^APCLSRT(X,4,APCLFILE))
WRITE !,$CHAR(7),$CHAR(7),"Navigation not defined for the File! Notify programmer!",!!
SET APCLQUIT=""
QUIT
+2 SET APCLNAV=$PIECE(^APCLSRT(X,4,APCLFILE,0),U,2)
+3 QUIT
+4 ;
HEAD ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 SET APCLX="REPORT SORTING UTILITY"
WRITE !!?80-$LENGTH(APCLX)\2,APCLX
KILL APCLX,APCLFORC
+3 WRITE !
+4 WRITE !,"The ",@APCLRVON,APCLRPT,@APCLRVOF
+5 WRITE " report can be sorted by one or more"
+6 WRITE !,"of the following attributes. "
+7 WRITE "'<<===' indicates a mandatory selection.",!
+8 QUIT
SET I=0
+1 FOR
SET X=$ORDER(^APCLSRT("B",X))
IF X=""
QUIT
FOR Y=0:0
SET Y=$ORDER(^APCLSRT("B",X,Y))
IF 'Y
QUIT
IF $DATA(^APCLSRT(Y,2,"B",APCLPTMP))
DO M1
+2 WRITE !
QUIT
CHOICE DO M2
+1 IF (J-1)=1
SET APCLZZ=1
GOTO OK
+2 WRITE !!?6,"Your choice (1",$SELECT((J-1)>1:"-"_(J-1),1:""),"): "
+3 READ APCLZZ:DTIME
IF '$TEST
SET APCLZZ=U
+4 IF APCLZZ=""!(APCLZZ[U)
SET APCLQUIT=""
QUIT
+5 IF APCLZZ'?1N.2N!(APCLZZ>(J-1))
WRITE !!?6,$CHAR(7),"Type ",$SELECT((J-1)>1:"a number from 1",1:"number 1: "),$SELECT((J-1)>1:"-"_(J-1)_":",1:"")
WRITE !
GOTO CHOICE
+6 IF APCLZZ
IF APCLZZ'>J
GOTO OK
+7 GOTO CHOICE
OK SET Z=%APCL(APCLZZ)
SET (X,APCLSNO)=+Z
SET APCLSNA=$PIECE(Z,U,2)
SET APCLCSTG=APCLCSTG_APCLZZ_U
+1 KILL Z,%APCLB(X)
IF (J-1)>1
WRITE " ",APCLSNA
OK1 IF BY]""
SET BY=BY_","
+1 SET APCLREC=^APCLSRT(X,0)
+2 SET APCLDIC=^DIC(APCLFILE,0,"GL")
+3 DO CHKNAV
IF $DATA(APCLQUIT)
QUIT
+4 KILL J
+5 SET BY=BY_APCLNAV
+6 DO @("S"_$PIECE(APCLREC,U,2)_"^APCLSRT1")
+7 KILL APCLNAV,APCLREC
+8 IF $DATA(APCLQUIT)
QUIT
+9 IF $DATA(APCLFORC)
KILL APCLFORC
DO PRINT
QUIT
+10 IF BY["["
SET BY="["_$PIECE(BY,"[",2)
SET BY=$PIECE(BY,"]")_"]"
GOTO PRINT
+11 IF I<2
DO PRINT
QUIT
+12 WRITE !!,"Within ",APCLSNA,", want to sort by another attribute"
+13 SET %=2
DO YN^DICN
+14 IF %Y=U
SET APCLQUIT=""
QUIT
+15 IF "Nn"[$EXTRACT(%Y)
DO CHECK
IF $DATA(APCLFORC)
GOTO OK
DO PRINT
QUIT
+16 WRITE !!!
SET APCLN=APCLN+1
SET I=I-1
GOTO EN1
EXIT KILL X,J,Y,Z,%Y,APCLZ,APCLZZ,APCLDIC,APCLN,APCLPTMP,BY,FR,TO,FLDS,I,APCLQUIT,APCLFILE,APCLRPT,%,%DT,APCLDM,APCLI,APCLSET,BY1,BY2,DHD,DIC,DIOEND,DIR,DUOUT,B,P,APCLBEGD
+1 KILL APCLSNO,APCLSNA,%APCL,%APCLB,APCLRVOF,APCLRVON,APCLTRM
+2 KILL APCLX,APCLY,APCLMAND,APCLCSTG,APCLMANN,APCLMAN,APCLSRT,APCLCST,APCLTRM,APCLREC,APCLNAV,APCLFORC,APCLPS
+3 DO ^%ZISC
+4 IF '$DATA(ZTQUEUED)
SET IOP="HOME"
DO ^%ZIS
+5 IF $DATA(IOF)
WRITE @IOF
+6 QUIT
M1 NEW Z
+1 SET Z=$ORDER(^APCLSRT(Y,2,"B",APCLPTMP,""))
SET Z=^(Z)
+2 SET I=I+1
SET %APCLB(Y)=Y_U_X_U_Z
+3 QUIT
M2 KILL %APCL
SET APCLZ=""
+1 FOR J=1:1
SET APCLZ=$ORDER(%APCLB(APCLZ))
IF 'APCLZ
QUIT
SET (%APCL(J),APCLSRT)=%APCLB(APCLZ)
SET X=$PIECE(APCLSRT,U,2)
SET Y=$PIECE(APCLSRT,U)
SET Z=$PIECE(APCLSRT,U,3)
IF J#2
WRITE !?6
IF '(J#2)
WRITE ?45
WRITE $JUSTIFY(J,3),") ",X
IF Z
WRITE " <<==="
SET APCLMAND=J
SET APCLMANN=X
SET APCLMAN=Y_U_X
+2 KILL APCLSRT,APCLZ
+3 QUIT
TITLE ;
+1 SET DIR(0)="FO^2:60"
SET DIR("A")="Please enter a TITLE for this report: "
SET DIR("B")="PATIENT LISTING"
SET DIR("?")="Enter a narrative title that you want to see on this report"
DO ^DIR
KILL DIR
+2 IF $DATA(DUOUT)
SET APCLQUIT=""
QUIT
+3 SET DHD=X
+4 QUIT
PRINT ;
+1 DO TITLE
+2 IF $DATA(APCLQUIT)
QUIT
PRNT SET DIC=APCLDIC
PRT1 SET DIOEND="D EOR^APCLSRT"
DIP DO EN1^DIP
+1 QUIT
CHECK IF APCLCSTG[(U_APCLMAND_U)
QUIT
+1 SET APCLZZ=APCLMAND
SET APCLFORC=""
SET APCLN=APCLN+1
+2 WRITE !!,$CHAR(7),"You must also sort by"
+3 QUIT
EOR ;
+1 IF $DATA(IOST)
IF IOST["C-"
WRITE !!,"End of report. Strike <CR> to continue"
READ APCLX:300
+2 IF $DATA(IOF)
WRITE @IOF
+3 QUIT
