APCLSRT.m

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

MENU S X="",I=0

 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 

MENU       SET X=""

           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