SRTPLS ;BIR/SJA - LIST ASSESSMENTS ;04/11/08
 ;;3.0; Surgery ;**167**;24 Jun 93;Build 27
 S (SRSOUT,SRFLG,SRSP,SRAST)=0,SRSRT=1
DATE D DATE^SROUTL(.SRSD,.SRED,.SRSOUT) G:SRSOUT END
 D STATUS G:SRSOUT END D TYPE G:SRSOUT END
 N SRINSTP S SRINST=$$INST^SROUTL0() G:SRINST="^" END S SRINSTP=$P(SRINST,"^"),SRINST=$S(SRINST["ALL DIVISIONS":SRINST,1:$P(SRINST,"^",2))
 W @IOF,!,"This report is designed to print to your terminal screen or a printer. When",!,"using a printer, a 132 column format is used.",!
 K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Print the List of Transplant Assessments to which Device: ",%ZIS="QM" D ^%ZIS I POP S SRSOUT=1 G END
 I $D(IO("Q")) K IO("Q") D  S ZTREQ="@" D ^%ZTLOAD G END
 .S ZTRTN="EN^SRTPLS",ZTDESC="List of Transplant Assessments"
 .S (ZTSAVE("SRSD"),ZTSAVE("SRED"),ZTSAVE("SRAST"),ZTSAVE("SRTYPE"),ZTSAVE("SRSRT"))="",ZTSAVE("SRINSTP")=""
EN ; entry when queued
 N SRFRTO S Y=SRSD X ^DD("DD") S SRFRTO="FROM: "_Y_"  TO: ",Y=SRED X ^DD("DD") S SRFRTO=SRFRTO_Y
 U IO S SRSD=SRSD-.0001,SRED=SRED_".9999",Y=DT X ^DD("DD") S SRPRINT="DATE PRINTED: "_Y
 S SRINST=$S(SRINSTP["ALL DIV":$P($$SITE^SROVAR,"^",2)_" - ALL DIVISIONS",1:$$GET1^DIQ(4,SRINSTP,.01))
 D ^SRTPLST G END
 Q
END I 'SRSOUT,$E(IOST)'="P" W !!,"Press ENTER to continue  " R X:DTIME
 W:$E(IOST)="P" @IOF K ^TMP("SRA",$J) I $D(ZTQUEUED) Q:$G(ZTSTOP)  S ZTREQ="@" Q
 D ^%ZISC K SRTPP,SRAST W @IOF D ^SRSKILL
 Q
STATUS ; select type of Assessment Status
 W ! K DIR S DIR("A",1)="Print which Assessment Status ?",DIR("A",2)="",DIR("A",3)="   1. Incomplete Only"
 S DIR("A",4)="   2. Complete/Transmitted",DIR("A",5)="   3. ALL",DIR("A",6)=""
 S DIR("A")="Select Number",DIR("B")=3,DIR(0)="N^1:3" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
 S SRAST=$S(Y=1:"I",Y=2:"CT",1:"ALL")
 Q
TYPE W ! K DIR S DIR("A",1)="Select Type of Transplant ?",DIR("A",2)="",DIR("A",3)="   1. Kidney"
 S DIR("A",4)="   2. Liver",DIR("A",5)="   3. Lung",DIR("A",6)="   4. Heart",DIR("A",7)="   5. ALL",DIR("A",8)=""
 S DIR("A")="Select Number",DIR("B")=5,DIR(0)="N^1:5" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
 S SRTYPE=$S(Y=1:"K",Y=2:"LI",Y=3:"LU",Y=4:"H",1:"ALL")
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRTPLS   2171     printed  Sep 23, 2025@20:24:58                                                                                                                                                                                                      Page 2
SRTPLS    ;BIR/SJA - LIST ASSESSMENTS ;04/11/08
 +1       ;;3.0; Surgery ;**167**;24 Jun 93;Build 27
 +2        SET (SRSOUT,SRFLG,SRSP,SRAST)=0
           SET SRSRT=1
DATE       DO DATE^SROUTL(.SRSD,.SRED,.SRSOUT)
           if SRSOUT
               GOTO END
 +1        DO STATUS
           if SRSOUT
               GOTO END
           DO TYPE
           if SRSOUT
               GOTO END
 +2        NEW SRINSTP
           SET SRINST=$$INST^SROUTL0()
           if SRINST="^"
               GOTO END
           SET SRINSTP=$PIECE(SRINST,"^")
           SET SRINST=$SELECT(SRINST["ALL DIVISIONS":SRINST,1:$PIECE(SRINST,"^",2))
 +3        WRITE @IOF,!,"This report is designed to print to your terminal screen or a printer. When",!,"using a printer, a 132 column format is used.",!
 +4        KILL IOP,%ZIS,POP,IO("Q")
           SET %ZIS("A")="Print the List of Transplant Assessments to which Device: "
           SET %ZIS="QM"
           DO ^%ZIS
           IF POP
               SET SRSOUT=1
               GOTO END
 +5        IF $DATA(IO("Q"))
               KILL IO("Q")
               Begin DoDot:1
 +6                SET ZTRTN="EN^SRTPLS"
                   SET ZTDESC="List of Transplant Assessments"
 +7                SET (ZTSAVE("SRSD"),ZTSAVE("SRED"),ZTSAVE("SRAST"),ZTSAVE("SRTYPE"),ZTSAVE("SRSRT"))=""
                   SET ZTSAVE("SRINSTP")=""
               End DoDot:1
               SET ZTREQ="@"
               DO ^%ZTLOAD
               GOTO END
EN        ; entry when queued
 +1        NEW SRFRTO
           SET Y=SRSD
           XECUTE ^DD("DD")
           SET SRFRTO="FROM: "_Y_"  TO: "
           SET Y=SRED
           XECUTE ^DD("DD")
           SET SRFRTO=SRFRTO_Y
 +2        USE IO
           SET SRSD=SRSD-.0001
           SET SRED=SRED_".9999"
           SET Y=DT
           XECUTE ^DD("DD")
           SET SRPRINT="DATE PRINTED: "_Y
 +3        SET SRINST=$SELECT(SRINSTP["ALL DIV":$PIECE($$SITE^SROVAR,"^",2)_" - ALL DIVISIONS",1:$$GET1^DIQ(4,SRINSTP,.01))
 +4        DO ^SRTPLST
           GOTO END
 +5        QUIT 
END        IF 'SRSOUT
               IF $EXTRACT(IOST)'="P"
                   WRITE !!,"Press ENTER to continue  "
                   READ X:DTIME
 +1        if $EXTRACT(IOST)="P"
               WRITE @IOF
           KILL ^TMP("SRA",$JOB)
           IF $DATA(ZTQUEUED)
               if $GET(ZTSTOP)
                   QUIT 
               SET ZTREQ="@"
               QUIT 
 +2        DO ^%ZISC
           KILL SRTPP,SRAST
           WRITE @IOF
           DO ^SRSKILL
 +3        QUIT 
STATUS    ; select type of Assessment Status
 +1        WRITE !
           KILL DIR
           SET DIR("A",1)="Print which Assessment Status ?"
           SET DIR("A",2)=""
           SET DIR("A",3)="   1. Incomplete Only"
 +2        SET DIR("A",4)="   2. Complete/Transmitted"
           SET DIR("A",5)="   3. ALL"
           SET DIR("A",6)=""
 +3        SET DIR("A")="Select Number"
           SET DIR("B")=3
           SET DIR(0)="N^1:3"
           DO ^DIR
           KILL DIR
           IF $DATA(DTOUT)!$DATA(DUOUT)
               SET SRSOUT=1
 +4        SET SRAST=$SELECT(Y=1:"I",Y=2:"CT",1:"ALL")
 +5        QUIT 
TYPE       WRITE !
           KILL DIR
           SET DIR("A",1)="Select Type of Transplant ?"
           SET DIR("A",2)=""
           SET DIR("A",3)="   1. Kidney"
 +1        SET DIR("A",4)="   2. Liver"
           SET DIR("A",5)="   3. Lung"
           SET DIR("A",6)="   4. Heart"
           SET DIR("A",7)="   5. ALL"
           SET DIR("A",8)=""
 +2        SET DIR("A")="Select Number"
           SET DIR("B")=5
           SET DIR(0)="N^1:5"
           DO ^DIR
           KILL DIR
           IF $DATA(DTOUT)!$DATA(DUOUT)
               SET SRSOUT=1
 +3        SET SRTYPE=$SELECT(Y=1:"K",Y=2:"LI",Y=3:"LU",Y=4:"H",1:"ALL")
 +4        QUIT