SROREQ3.m

SROREQ3 ;BIR/MAM - REQUESTS FOR A DAY (SHORT FORM) ; [ 12/09/99  11:54 AM ]

 ;;3.0; Surgery ;**26,48,92**;24 Jun 93

 W ! K DIC S DIC("S")="I '$P(^(0),""^"",3)",DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Print Requests for which Surgical Specialty ?  " D ^DIC I Y'>0 S SRSOUT=1 G END

 S SRSS=+Y,SRSNM=$P(Y(0),"^")

 W ! K IOP,POP,IO("Q"),%ZIS S %ZIS("A")="Print the Requests on which Device: ",%ZIS="Q" D ^%ZIS I POP S SRSOUT=1 G END

 I $D(IO("Q")) K IO("Q") S ZTDESC="OPERATION REQUESTS (SHORT FORM)",ZTRTN="BEG^SROREQ3",(ZTSAVE("SRSDATE"),ZTSAVE("SRSS"),ZTSAVE("SRSNM"),ZTSAVE("SRSITE*"))="" D ^%ZTLOAD S SRSOUT=1 G END

BEG ; entry when queued

 K ^TMP("SR",$J) U IO S (CNT,DFN,SRSOUT)=0,Y=SRSDATE,SRDT=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3) D D^DIQ S SRSDT=$E(Y,1,12) D HDR Q:SRSOUT

 F  S DFN=$O(^SRF("AR",SRSDATE,DFN)) Q:'DFN  S SRTN=0 F  S SRTN=$O(^SRF("AR",SRSDATE,DFN,SRTN)) Q:'SRTN  I $D(^SRF(SRTN,0)),$$DIV^SROUTL0(SRTN),$P(^SRF(SRTN,0),"^",4)=SRSS D SET

 S SREQDT=0 F  S SREQDT=$O(^TMP("SR",$J,SREQDT)) Q:SREQDT=""!(SRSOUT)  S SRTN=0 F  S SRTN=$O(^TMP("SR",$J,SREQDT,SRTN)) Q:'SRTN!(SRSOUT)  D PRINT

END W:$E(IOST)="P" @IOF I $D(ZTQUEUED) K ^TMP("SR",$J) Q:$G(ZTSTOP)  S ZTREQ="@" Q

 S:$E(IOST)="P" SRSOUT=1 I 'SRSOUT W !!,"Press RETURN to continue  " R X:DTIME

 D ^%ZISC D ^SRSKILL K SRTN W @IOF

 Q

SET ; set ^TMP(

 S SREQDT=$P($G(^SRF(SRTN,"1.0")),"^",11) S:'SREQDT SREQDT="ZZ" S ^TMP("SR",$J,SREQDT,SRTN)=""

 Q

HDR ; print heading

 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q

 W:$Y @IOF W !,"OPERATION REQUESTS FOR "_SRSNM,?70,SRDT,! F LINE=1:1:80 W "-"

 Q

PRINT ; print request info

 I $Y+7>IOSL D PAGE I SRSOUT Q

 S SR(0)=^SRF(SRTN,0),DFN=$P(^SRF(SRTN,0),"^"),CNT=CNT+1

 D DEM^VADPT S SRNAME=VADM(1),SROPER=$P(^SRF(SRTN,"OP"),"^")

 S SRSUR=$P($G(^SRF(SRTN,.1)),"^",4),SRSUR=$S(SRSUR:$P(^VA(200,SRSUR,0),"^"),1:"NOT ENTERED")

 S SRHRS=$P($G(^SRF(SRTN,.4)),"^"),SRSDT=$E(SRSDATE,4,5)_"/"_$E(SRSDATE,6,7)_"/"_$E(SRSDATE,2,3)

 S:SRHRS="" SRHRS="NOT ENTERED" S C=$P(^DD(130,.035,0),"^",2),Y=$P(SR(0),"^",10) D:Y'="" Y^DIQ S SRTYPE=Y,SRANES=$P($G(^SRF(SRTN,"1.0")),"^"),Y=SRANES,C=$P(^DD(130,1.01,0),"^",2) D:Y'="" Y^DIQ S SRANES=Y

 S SRSORD=$P(SR(0),"^",11),SSN=VA("PID"),SRWARD=$S($D(^DPT(DFN,.1)):^(.1),1:"") I SRTYPE'="" S SRTYPE=" ("_$P(SRTYPE,"(")_")"

 K SROPS,MM,MMM S SROPER=SROPER_SRTYPE S:$L(SROPER)<63 SROPS(1)=SROPER I $L(SROPER)>62 S SROPER=SROPER_"  " F M=1:1 D LOOP Q:MMM=""

 W !!,CNT_".",?5,"Case Number: "_SRTN,?40,"Operation Date: "_SRSDT,!,?5,"Patient: ",?16,SRNAME,?40,"Ward: ",SRWARD,!,?5,"ID#: ",?16,VA("PID"),?40,"Surgeon: "_SRSUR,!,?5,"Procedure: "_SROPS(1)

 I $D(SROPS(2)) W !,?16,SROPS(2) I $D(SROPS(3)) W !,?16,SROPS(3) I $D(SROPS(4)) W !,?16,SROPS(4)

 W !,?5,"Estimated Case Length: "_SRHRS W:SRSORD'="" !,?5,"Case Schedule Order: "_SRSORD W:SRANES'="" !,?5,"Requested Anesthesia:  "_SRANES

 K SRSCON I $D(^SRF(SRTN,"CON")),$P(^("CON"),"^") S SRSCON=$P(^("CON"),"^") K A S SROPER=$P(^SRF(SRSCON,"OP"),"^") S:$L(SROPER)<65 SROPS(1)=SROPER I $L(SROPER)>64 S SROPER=SROPER_"  " F M=1:1 D LOOP Q:MM=""

 I $D(SRSCON) W !,"Concurrent Case # "_SRSCON,!,SROPS(1) I $D(SROPS(2)) W !,SROPS(2) I $D(SROPS(3)) W !,SROPS(3)

 Q

LOOP ; break procedure if greater than 63 characters

 S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM=""  Q:$L(SROPS(M))+$L(MM)'<63  S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM

 Q

PAGE I $E(IOST)'="P" W !!,"Press RETURN to continue, or '^' to quit:  " R X:DTIME I X["^" S SRSOUT=1 Q

 D HDR

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SROREQ3   3501     printed  Mar 13, 2025@21:50:58                                                                                                                                                                                                     Page 2

SROREQ3   ;BIR/MAM - REQUESTS FOR A DAY (SHORT FORM) ; [ 12/09/99  11:54 AM ]

 +1       ;;3.0; Surgery ;**26,48,92**;24 Jun 93

 +2        WRITE !

           KILL DIC

           SET DIC("S")="I '$P(^(0),""^"",3)"

           SET DIC=137.45

           SET DIC(0)="QEAMZ"

           SET DIC("A")="Print Requests for which Surgical Specialty ?  "

           DO ^DIC

           IF Y'>0

               SET SRSOUT=1

               GOTO END

 +3        SET SRSS=+Y

           SET SRSNM=$PIECE(Y(0),"^")

 +4        WRITE !

           KILL IOP,POP,IO("Q"),%ZIS

           SET %ZIS("A")="Print the Requests on which Device: "

           SET %ZIS="Q"

           DO ^%ZIS

           IF POP

               SET SRSOUT=1

               GOTO END

 +5        IF $DATA(IO("Q"))

               KILL IO("Q")

               SET ZTDESC="OPERATION REQUESTS (SHORT FORM)"

               SET ZTRTN="BEG^SROREQ3"

               SET (ZTSAVE("SRSDATE"),ZTSAVE("SRSS"),ZTSAVE("SRSNM"),ZTSAVE("SRSITE*"))=""

               DO ^%ZTLOAD

               SET SRSOUT=1

               GOTO END

BEG       ; entry when queued

 +1        KILL ^TMP("SR",$JOB)

           USE IO

           SET (CNT,DFN,SRSOUT)=0

           SET Y=SRSDATE

           SET SRDT=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)

           DO D^DIQ

           SET SRSDT=$EXTRACT(Y,1,12)

           DO HDR

           if SRSOUT

               QUIT 

 +2        FOR 

               SET DFN=$ORDER(^SRF("AR",SRSDATE,DFN))

               if 'DFN

                   QUIT 

               SET SRTN=0

               FOR 

                   SET SRTN=$ORDER(^SRF("AR",SRSDATE,DFN,SRTN))

                   if 'SRTN

                       QUIT 

                   IF $DATA(^SRF(SRTN,0))

                       IF $$DIV^SROUTL0(SRTN)

                           IF $PIECE(^SRF(SRTN,0),"^",4)=SRSS

                               DO SET

 +3        SET SREQDT=0

           FOR 

               SET SREQDT=$ORDER(^TMP("SR",$JOB,SREQDT))

               if SREQDT=""!(SRSOUT)

                   QUIT 

               SET SRTN=0

               FOR 

                   SET SRTN=$ORDER(^TMP("SR",$JOB,SREQDT,SRTN))

                   if 'SRTN!(SRSOUT)

                       QUIT 

                   DO PRINT

END        if $EXTRACT(IOST)="P"

               WRITE @IOF

           IF $DATA(ZTQUEUED)

               KILL ^TMP("SR",$JOB)

               if $GET(ZTSTOP)

                   QUIT 

               SET ZTREQ="@"

               QUIT 

 +1        if $EXTRACT(IOST)="P"

               SET SRSOUT=1

           IF 'SRSOUT

               WRITE !!,"Press RETURN to continue  "

               READ X:DTIME

 +2        DO ^%ZISC

           DO ^SRSKILL

           KILL SRTN

           WRITE @IOF

 +3        QUIT 

SET       ; set ^TMP(

 +1        SET SREQDT=$PIECE($GET(^SRF(SRTN,"1.0")),"^",11)

           if 'SREQDT

               SET SREQDT="ZZ"

           SET ^TMP("SR",$JOB,SREQDT,SRTN)=""

 +2        QUIT 

HDR       ; print heading

 +1        IF $DATA(ZTQUEUED)

               DO ^SROSTOP

               IF SRHALT

                   SET SRSOUT=1

                   QUIT 

 +2        if $Y

               WRITE @IOF

           WRITE !,"OPERATION REQUESTS FOR "_SRSNM,?70,SRDT,!

           FOR LINE=1:1:80

               WRITE "-"

 +3        QUIT 

PRINT     ; print request info

 +1        IF $Y+7>IOSL

               DO PAGE

               IF SRSOUT

                   QUIT 

 +2        SET SR(0)=^SRF(SRTN,0)

           SET DFN=$PIECE(^SRF(SRTN,0),"^")

           SET CNT=CNT+1

 +3        DO DEM^VADPT

           SET SRNAME=VADM(1)

           SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")

 +4        SET SRSUR=$PIECE($GET(^SRF(SRTN,.1)),"^",4)

           SET SRSUR=$SELECT(SRSUR:$PIECE(^VA(200,SRSUR,0),"^"),1:"NOT ENTERED")

 +5        SET SRHRS=$PIECE($GET(^SRF(SRTN,.4)),"^")

           SET SRSDT=$EXTRACT(SRSDATE,4,5)_"/"_$EXTRACT(SRSDATE,6,7)_"/"_$EXTRACT(SRSDATE,2,3)

 +6        if SRHRS=""

               SET SRHRS="NOT ENTERED"

           SET C=$PIECE(^DD(130,.035,0),"^",2)

           SET Y=$PIECE(SR(0),"^",10)

           if Y'=""

               DO Y^DIQ

           SET SRTYPE=Y

           SET SRANES=$PIECE($GET(^SRF(SRTN,"1.0")),"^")

           SET Y=SRANES

           SET C=$PIECE(^DD(130,1.01,0),"^",2)

           if Y'=""

               DO Y^DIQ

           SET SRANES=Y

 +7        SET SRSORD=$PIECE(SR(0),"^",11)

           SET SSN=VA("PID")

           SET SRWARD=$SELECT($DATA(^DPT(DFN,.1)):^(.1),1:"")

           IF SRTYPE'=""

               SET SRTYPE=" ("_$PIECE(SRTYPE,"(")_")"

 +8        KILL SROPS,MM,MMM

           SET SROPER=SROPER_SRTYPE

           if $LENGTH(SROPER)<63

               SET SROPS(1)=SROPER

           IF $LENGTH(SROPER)>62

               SET SROPER=SROPER_"  "

               FOR M=1:1

                   DO LOOP

                   if MMM=""

                       QUIT 

 +9        WRITE !!,CNT_".",?5,"Case Number: "_SRTN,?40,"Operation Date: "_SRSDT,!,?5,"Patient: ",?16,SRNAME,?40,"Ward: ",SRWARD,!,?5,"ID#: ",?16,VA("PID"),?40,"Surgeon: "_SRSUR,!,?5,"Procedure: "_SROPS(1)

 +10       IF $DATA(SROPS(2))

               WRITE !,?16,SROPS(2)

               IF $DATA(SROPS(3))

                   WRITE !,?16,SROPS(3)

                   IF $DATA(SROPS(4))

                       WRITE !,?16,SROPS(4)

 +11       WRITE !,?5,"Estimated Case Length: "_SRHRS

           if SRSORD'=""

               WRITE !,?5,"Case Schedule Order: "_SRSORD

           if SRANES'=""

               WRITE !,?5,"Requested Anesthesia:  "_SRANES

 +12       KILL SRSCON

           IF $DATA(^SRF(SRTN,"CON"))

               IF $PIECE(^("CON"),"^")

                   SET SRSCON=$PIECE(^("CON"),"^")

                   KILL A

                   SET SROPER=$PIECE(^SRF(SRSCON,"OP"),"^")

                   if $LENGTH(SROPER)<65

                       SET SROPS(1)=SROPER

                   IF $LENGTH(SROPER)>64

                       SET SROPER=SROPER_"  "

                       FOR M=1:1

                           DO LOOP

                           if MM=""

                               QUIT 

 +13       IF $DATA(SRSCON)

               WRITE !,"Concurrent Case # "_SRSCON,!,SROPS(1)

               IF $DATA(SROPS(2))

                   WRITE !,SROPS(2)

                   IF $DATA(SROPS(3))

                       WRITE !,SROPS(3)

 +14       QUIT 

LOOP      ; break procedure if greater than 63 characters

 +1        SET SROPS(M)=""

           FOR LOOP=1:1

               SET MM=$PIECE(SROPER," ")

               SET MMM=$PIECE(SROPER," ",2,200)

               if MMM=""

                   QUIT 

               if $LENGTH(SROPS(M))+$LENGTH(MM)'<63

                   QUIT 

               SET SROPS(M)=SROPS(M)_MM_" "

               SET SROPER=MMM

 +2        QUIT 

PAGE       IF $EXTRACT(IOST)'="P"

               WRITE !!,"Press RETURN to continue, or '^' to quit:  "

               READ X:DTIME

               IF X["^"

                   SET SRSOUT=1

                   QUIT 

 +1        DO HDR

 +2        QUIT