SROALOG ;BIR/MAM - ASSESSMENT LOG ;01/24/08
;;3.0;Surgery;**38,55,62,77,50,153,160,166,184**;24 Jun 93;Build 35
K SRMNA S (SRSOUT,SRFLG,SRSP,SRAST)=0,SRSRT=1
START G:SRSOUT END W @IOF K DIR S DIR("A",1)="List of Surgery Risk Assessments",DIR("A",2)="",DIR("A",3)=" 1. List of Incomplete Assessments"
S DIR("A",4)=" 2. List of Completed Assessments",DIR("A",5)=" 3. List of Transmitted Assessments"
S DIR("A",6)=" 4. List of Non-Assessed Major Surgical Cases (Deactivated)",DIR("A",7)=" 5. List of All Major Surgical Cases (Deactivated)"
S DIR("A",8)=" 6. List of All Surgical Cases",DIR("A",9)=" 7. List of Completed/Transmitted Assessments Missing Information"
S DIR("A",10)=" 8. List of 1-Liner Cases Missing Information",DIR("A",11)=" 9. List of Eligible Cases"
S DIR("A",12)=" 10. List of Cases With No CPT Codes",DIR("A",13)=" 11. Summary List of Assessed Cases"
S DIR("A",14)="",DIR("A")="Select the Number of the Report Desired"
S DIR(0)="NO^1:11" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT)!'Y S SRSOUT=1 G END
S SREPORT=X
DATE I SREPORT=3 D DSORT G:SRSOUT END
I SREPORT=4 D NL G SROALOG
I SREPORT=5 D NL G SROALOG
D DATE^SROUTL(.SRSD,.SRED,.SRSOUT) G:SRSOUT END
I SREPORT=9 D TYPE9 I SRSOUT G END
I SREPORT=3 D TYPE3 I SRSOUT G END
D SEL 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))
I SREPORT<7 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 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^SROALOG",ZTDESC="List of Surgery Risk Assessments"
.S (ZTSAVE("SRSD"),ZTSAVE("SRED"),ZTSAVE("SREPORT"),ZTSAVE("SRASP"),ZTSAVE("SRFLG"),ZTSAVE("SRSP"),ZTSAVE("SRINSTP"),ZTSAVE("SRAST"),ZTSAVE("SRSRT"))=""
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))
I SREPORT=1 D:SRSP ^SROANTS D:'SRSP ^SROANT G END
I SREPORT=2 D:SRSP ^SROALCS D:'SRSP ^SROALC G END
I SREPORT=3 D:SRSP ^SROALTS D:'SRSP ^SROALT G END
I SREPORT=7 D ^SROALM G END
I SREPORT=8 D ^SROALMN G END
I SREPORT=9 D ^SROALEC G END
I SREPORT=10 D ^SROALNC G END
I SREPORT=11 D ^SROALSL G END
D:SRSP ^SROALSS D:'SRSP ^SROALST
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 SRTN,SRAST,SRSRT W @IOF D ^SRSKILL
Q
TYPE3 ; select type of eligible cases
W ! K DIR S DIR("A",1)="Print which Transmitted Cases ?",DIR("A",2)="",DIR("A",3)=" 1. Assessed Cases Only"
S DIR("A",4)=" 2. Excluded Cases Only",DIR("A",5)=" 3. Both Assessed and Excluded",DIR("A",6)=""
S DIR("A")="Select Number",DIR("B")=1,DIR(0)="N^1:3" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
S SRAST=Y
Q
TYPE9 ; select type of transmitted case
W ! K DIR S DIR("A",1)="Print which Eligible Cases ?",DIR("A",2)="",DIR("A",3)=" 1. Assessed Cases Only"
S DIR("A",4)=" 2. Excluded Cases Only",DIR("A",5)=" 3. Non-Assessed Cases only",DIR("A",6)=" 4. All Cases",DIR("A",7)=""
S DIR("A")="Select Number",DIR("B")=1,DIR(0)="N^1:4" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
S SRAST=Y
Q
DSORT ; sort by op date or transmit date
W ! K DIR S DIR("A",1)="Print by Date of Operation or by Date of Transmission ?",DIR("A",2)="",DIR("A",3)=" 1. Date of Operation"
S DIR("A",4)=" 2. Date of Transmission",DIR("A",5)="",DIR("A")="Select Number",DIR("B")=1,DIR(0)="N^1:2"
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1
S SRSRT=Y
Q
SEL ; select specialty
W ! K DIR S DIR(0)="YA",DIR("A")="Print by Surgical Specialty ? ",DIR("B")="YES"
S DIR("?",1)="Enter YES to print the report by surgical specialty, or NO to print",DIR("?")="the report listing all surgical cases."
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
Q:'Y
SEL1 S SRSP=1 W ! K DIR S DIR(0)="YA",DIR("A")="Print report for ALL specialties ? ",DIR("B")="YES"
S DIR("?",1)="Enter YES to print the report for all surgical specialties, or NO to",DIR("?")="print the report for a specific surgical specialty."
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
I 'Y W ! S DIC("S")="I '$P(^(0),""^"",3)",DIC("A")="Print the Report for which Surgical Specialty: ",DIC=137.45,DIC(0)="QEAMZ" D ^DIC K DIC I Y>0 S SRASP=+Y,SRFLG=1 Q
I Y'>0 S SRSOUT=1 Q
Q
NL W !!,"This display is no longer used. Please select a different list."
W !!,"Press ENTER to continue " R X:DTIME
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROALOG 4899 printed Dec 13, 2024@02:40:54 Page 2
SROALOG ;BIR/MAM - ASSESSMENT LOG ;01/24/08
+1 ;;3.0;Surgery;**38,55,62,77,50,153,160,166,184**;24 Jun 93;Build 35
+2 KILL SRMNA
SET (SRSOUT,SRFLG,SRSP,SRAST)=0
SET SRSRT=1
START if SRSOUT
GOTO END
WRITE @IOF
KILL DIR
SET DIR("A",1)="List of Surgery Risk Assessments"
SET DIR("A",2)=""
SET DIR("A",3)=" 1. List of Incomplete Assessments"
+1 SET DIR("A",4)=" 2. List of Completed Assessments"
SET DIR("A",5)=" 3. List of Transmitted Assessments"
+2 SET DIR("A",6)=" 4. List of Non-Assessed Major Surgical Cases (Deactivated)"
SET DIR("A",7)=" 5. List of All Major Surgical Cases (Deactivated)"
+3 SET DIR("A",8)=" 6. List of All Surgical Cases"
SET DIR("A",9)=" 7. List of Completed/Transmitted Assessments Missing Information"
+4 SET DIR("A",10)=" 8. List of 1-Liner Cases Missing Information"
SET DIR("A",11)=" 9. List of Eligible Cases"
+5 SET DIR("A",12)=" 10. List of Cases With No CPT Codes"
SET DIR("A",13)=" 11. Summary List of Assessed Cases"
+6 SET DIR("A",14)=""
SET DIR("A")="Select the Number of the Report Desired"
+7 SET DIR(0)="NO^1:11"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)!'Y
SET SRSOUT=1
GOTO END
+8 SET SREPORT=X
DATE IF SREPORT=3
DO DSORT
if SRSOUT
GOTO END
+1 IF SREPORT=4
DO NL
GOTO SROALOG
+2 IF SREPORT=5
DO NL
GOTO SROALOG
+3 DO DATE^SROUTL(.SRSD,.SRED,.SRSOUT)
if SRSOUT
GOTO END
+4 IF SREPORT=9
DO TYPE9
IF SRSOUT
GOTO END
+5 IF SREPORT=3
DO TYPE3
IF SRSOUT
GOTO END
+6 DO SEL
if SRSOUT
GOTO END
+7 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))
+8 IF SREPORT<7
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.",!
+9 KILL IOP,%ZIS,POP,IO("Q")
SET %ZIS("A")="Print the List of Assessments to which Device: "
SET %ZIS="QM"
DO ^%ZIS
IF POP
SET SRSOUT=1
GOTO END
+10 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:1
+11 SET ZTRTN="EN^SROALOG"
SET ZTDESC="List of Surgery Risk Assessments"
+12 SET (ZTSAVE("SRSD"),ZTSAVE("SRED"),ZTSAVE("SREPORT"),ZTSAVE("SRASP"),ZTSAVE("SRFLG"),ZTSAVE("SRSP"),ZTSAVE("SRINSTP"),ZTSAVE("SRAST"),ZTSAVE("SRSRT"))=""
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 IF SREPORT=1
if SRSP
DO ^SROANTS
if 'SRSP
DO ^SROANT
GOTO END
+5 IF SREPORT=2
if SRSP
DO ^SROALCS
if 'SRSP
DO ^SROALC
GOTO END
+6 IF SREPORT=3
if SRSP
DO ^SROALTS
if 'SRSP
DO ^SROALT
GOTO END
+7 IF SREPORT=7
DO ^SROALM
GOTO END
+8 IF SREPORT=8
DO ^SROALMN
GOTO END
+9 IF SREPORT=9
DO ^SROALEC
GOTO END
+10 IF SREPORT=10
DO ^SROALNC
GOTO END
+11 IF SREPORT=11
DO ^SROALSL
GOTO END
+12 if SRSP
DO ^SROALSS
if 'SRSP
DO ^SROALST
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 SRTN,SRAST,SRSRT
WRITE @IOF
DO ^SRSKILL
+3 QUIT
TYPE3 ; select type of eligible cases
+1 WRITE !
KILL DIR
SET DIR("A",1)="Print which Transmitted Cases ?"
SET DIR("A",2)=""
SET DIR("A",3)=" 1. Assessed Cases Only"
+2 SET DIR("A",4)=" 2. Excluded Cases Only"
SET DIR("A",5)=" 3. Both Assessed and Excluded"
SET DIR("A",6)=""
+3 SET DIR("A")="Select Number"
SET DIR("B")=1
SET DIR(0)="N^1:3"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
+4 SET SRAST=Y
+5 QUIT
TYPE9 ; select type of transmitted case
+1 WRITE !
KILL DIR
SET DIR("A",1)="Print which Eligible Cases ?"
SET DIR("A",2)=""
SET DIR("A",3)=" 1. Assessed Cases Only"
+2 SET DIR("A",4)=" 2. Excluded Cases Only"
SET DIR("A",5)=" 3. Non-Assessed Cases only"
SET DIR("A",6)=" 4. All Cases"
SET DIR("A",7)=""
+3 SET DIR("A")="Select Number"
SET DIR("B")=1
SET DIR(0)="N^1:4"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
+4 SET SRAST=Y
+5 QUIT
DSORT ; sort by op date or transmit date
+1 WRITE !
KILL DIR
SET DIR("A",1)="Print by Date of Operation or by Date of Transmission ?"
SET DIR("A",2)=""
SET DIR("A",3)=" 1. Date of Operation"
+2 SET DIR("A",4)=" 2. Date of Transmission"
SET DIR("A",5)=""
SET DIR("A")="Select Number"
SET DIR("B")=1
SET DIR(0)="N^1:2"
+3 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
+4 SET SRSRT=Y
+5 QUIT
SEL ; select specialty
+1 WRITE !
KILL DIR
SET DIR(0)="YA"
SET DIR("A")="Print by Surgical Specialty ? "
SET DIR("B")="YES"
+2 SET DIR("?",1)="Enter YES to print the report by surgical specialty, or NO to print"
SET DIR("?")="the report listing all surgical cases."
+3 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
QUIT
+4 if 'Y
QUIT
SEL1 SET SRSP=1
WRITE !
KILL DIR
SET DIR(0)="YA"
SET DIR("A")="Print report for ALL specialties ? "
SET DIR("B")="YES"
+1 SET DIR("?",1)="Enter YES to print the report for all surgical specialties, or NO to"
SET DIR("?")="print the report for a specific surgical specialty."
+2 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
QUIT
+3 IF 'Y
WRITE !
SET DIC("S")="I '$P(^(0),""^"",3)"
SET DIC("A")="Print the Report for which Surgical Specialty: "
SET DIC=137.45
SET DIC(0)="QEAMZ"
DO ^DIC
KILL DIC
IF Y>0
SET SRASP=+Y
SET SRFLG=1
QUIT
+4 IF Y'>0
SET SRSOUT=1
QUIT
+5 QUIT
NL WRITE !!,"This display is no longer used. Please select a different list."
+1 WRITE !!,"Press ENTER to continue "
READ X:DTIME
+2 QUIT
