- 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 Feb 19, 2025@00:15:01 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