SRTPLS.m

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

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