- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORLPR 1262 printed Feb 18, 2025@23:58:05 Page 2
- 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