ORLPR.m

ORLPR ; slc/CLA - Report formatter for patient lists ;11/27/91 [7/20/00 10:33am]

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,63,82**;Dec 17, 1997

INQ ;called by option ORLP EXAMINE/PRINT - Inquire to review/print lists

 N ORLIST,SORT,TL

 K IO("Q")

 W @IOF

 S SORT=$$GET^XPAR("USR.`"_DUZ,"ORLP DEFAULT LIST ORDER",1,"I") I SORT']"" S SORT="A"

 K DIC S DIC="^OR(100.21,",DIC(0)="AEQMZ"

 S DIC("A")="Select LIST to examine/print: "

 D GETDEF^ORLPL

 D ^DIC K DIC,DTOUT,DUOUT I Y<1 Q

 ;make list the default if type=team, contains users and current user belongs (else kill the default list to prevent confusion)

 S TL=$P(Y(0),U,2)

 I TL["T",$D(^OR(100.21,+Y,1,0))#2,$D(^(DUZ)) S ^TMP("ORLP",$J,"TLIST")=+Y

 ; Next line added by PKS - 3/2000; modified on 7/2000 for patch 82:

 I ((SORT'="R")&(SORT'="T")) S SORT="A" ; Only A, R, or T work here.

 E  K ^TMP("ORLP",$J,"TLIST")

 S ORLIST=Y

 D  Q:$D(DTOUT)!$D(DUOUT)

 . N DIR S DIR(0)="SO^A:ALPHABETIC;R:ROOM/BED;T:TERMINAL DIGIT",DIR("B")=SORT,DIR("A")="Sort by"

 . D ^DIR S SORT=Y

 S %ZIS="PQ",ZTSAVE("ORLIST")="",ZTSAVE("SORT")="",ZTSAVE("^TMP(""ORLP"",$J,""LIST"",")="",ZTSAVE("TL")="",ZTRTN="OUTPUT^ORLPR0",ZTDESC="OERR Patient/Team List Report"

 D IO^ORUTL1,END^ORLPR0 ;queue output then end

 Q

ORLPR     ; slc/CLA - Report formatter for patient lists ;11/27/91 [7/20/00 10:33am]

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,63,82**;Dec 17, 1997

INQ       ;called by option ORLP EXAMINE/PRINT - Inquire to review/print lists

 +1        NEW ORLIST,SORT,TL

 +2        KILL IO("Q")

 +3        WRITE @IOF

 +4        SET SORT=$$GET^XPAR("USR.`"_DUZ,"ORLP DEFAULT LIST ORDER",1,"I")

           IF SORT']""

               SET SORT="A"

 +5        KILL DIC

           SET DIC="^OR(100.21,"

           SET DIC(0)="AEQMZ"

 +6        SET DIC("A")="Select LIST to examine/print: "

 +7        DO GETDEF^ORLPL

 +8        DO ^DIC

           KILL DIC,DTOUT,DUOUT

           IF Y<1

               QUIT 

 +9       ;make list the default if type=team, contains users and current user belongs (else kill the default list to prevent confusion)

 +10       SET TL=$PIECE(Y(0),U,2)

 +11       IF TL["T"

               IF $DATA(^OR(100.21,+Y,1,0))#2

                   IF $DATA(^(DUZ))

                       SET ^TMP("ORLP",$JOB,"TLIST")=+Y

 +12      ; Next line added by PKS - 3/2000; modified on 7/2000 for patch 82:

 +13      ; Only A, R, or T work here.

           IF ((SORT'="R")&(SORT'="T"))

               SET SORT="A"

 +14      IF '$TEST

               KILL ^TMP("ORLP",$JOB,"TLIST")

 +15       SET ORLIST=Y

 +16       Begin DoDot:1

 +17           NEW DIR

               SET DIR(0)="SO^A:ALPHABETIC;R:ROOM/BED;T:TERMINAL DIGIT"

               SET DIR("B")=SORT

               SET DIR("A")="Sort by"

 +18           DO ^DIR

               SET SORT=Y

           End DoDot:1

           IF $DATA(DTOUT)!$DATA(DUOUT)

               QUIT 

 +19       SET %ZIS="PQ"

           SET ZTSAVE("ORLIST")=""

           SET ZTSAVE("SORT")=""

           SET ZTSAVE("^TMP(""ORLP"",$J,""LIST"",")=""

           SET ZTSAVE("TL")=""

           SET ZTRTN="OUTPUT^ORLPR0"

           SET ZTDESC="OERR Patient/Team List Report"

 +20      ;queue output then end

           DO IO^ORUTL1

           DO END^ORLPR0

 +21       QUIT