SROA30.m

SROA30 ;BIR/MAM - 30 DAY LETTERS AND MAIL MESSAGE ;01/26/06

 ;;3.0; Surgery ;**7,18,31,38,95,153**;24 Jun 93;Build 11

 S SRSOUT=0 W @IOF K DIR S DIR("A")="Do you want to edit the text of the letter",DIR("B")="NO",DIR(0)="Y" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) G END

 I Y S X="Division: "_SRSITE("SITE")_"  ("_SRSITE("DIV")_")" W @IOF,!,?(80-$L(X)\2),X,! K DA,DIE,DR S DA=SRSITE,DR="31",DIE=133 D ^DIE K DA,DIE,DR

ONE G:SRSOUT END W @IOF S DIR("?",1)="Enter <RET> to select a patient and print the letter for a specific risk",DIR("?")="assessment, or 'NO' to print letters for a date range."

 S DIR("A")="Do you want to print the letter for a specific assessment",DIR("B")="YES",DIR(0)="Y" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 G END

 I Y D ^SROASS S:'$D(SRTN) SRSOUT=1 G:SRSOUT END G IO

 S SRAMAN=1

 W !!,"This option will allow you to reprint the 30 day follow up letters for the date",!,"that they were originally printed.  When printed automatically, the letters",!,"print 25 days after the date of operation."

SDATE W !!,"Print letters for BEGINNING date: TODAY// " R X:DTIME I '$T!(X["^") S SRSOUT=1 G END

 I X["?" W !,"Enter the EARLIEST date for which you want letters printed." S X="?",%DT="E" D ^%DT G SDATE

 S:X="" X="T" S %DT="E" D ^%DT G SDATE:Y<1 S X1=Y,X2=-25 D C^%DTC S SRSTART=X

EDATE W !,"Print letters for ENDING date: TODAY// " R X:DTIME I '$T!(X["^") S SRSOUT=1 G END

 I X["?" W !,"Enter the LATEST date for which you want letters printed." S X="?",%DT="E" D ^%DT G EDATE

 S:X="" X="T" S %DT="E" D ^%DT G EDATE:Y<1 S X1=Y,X2=-25 D C^%DTC S SREND=X

 I SRSTART>SREND W !!,"The ENDING date must be later than the BEGINNING date.  Please try again." G SDATE

IO I $D(SRTN),$P($G(^SRF(SRTN,30)),"^") W !!,"The 30 Day Letter will not print because the case selected has been cancelled.",!!,"Press <RET> to continue " R X:DTIME G END

 I $D(SRTN),'$P($G(^SRF(SRTN,.2)),"^",12) W !!,"The 30 Day Letter will not print because for the case selected,",!,"the field, TIME PATIENT OUT OF OR, has not been filled in.",!!,"Press <RET> to continue " R X:DTIME G END

 I $D(SRTN),$P($G(^DPT(DFN,.35)),"^") W !!,"The 30 Day Letter will not print because the patient has a date of death.",!!,"Press <RET> to continue " R X:DTIME G END

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

 I $D(IO("Q")) K IO("Q") S ZTDESC="Risk Assessment 30 Day Letters",ZTSAVE("SR*")="",ZTRTN="BEG^SROA30" D ^%ZTLOAD S SRSOUT=1 G END

BEG ; Entry point when manually queued

 U IO I $D(SRTN) D ^SROALET G END

 S SRSOUT=0,SRSDATE=SRSTART-.0001,SREND=SREND_".9999" F  S SRSDATE=$O(^SRF("AC",SRSDATE)) Q:'SRSDATE!(SRSDATE>SREND)!(SRSOUT)  D

 .S SRTN=0 F  S SRTN=$O(^SRF("AC",SRSDATE,SRTN)) Q:'SRTN  I $$DIV^SROUTL0(SRTN) D ^SROALET I '$D(SRAMAN),$D(VADM(1)) D MSG

 G END

EN ; Entry point when tasked daily

 Q:$G(IO)=""  U IO S (SRSOUT,SRYN)=0

 S X1=DT,X2=-25 D C^%DTC S SRSDATE=X-.0001,SREND=X_".9999" F  S SRSDATE=$O(^SRF("AC",SRSDATE)) Q:'SRSDATE!(SRSDATE>SREND)!(SRSOUT)  D SRTN

 G END

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

 S SRTN=0 F  S SRTN=$O(^SRF("AC",SRSDATE,SRTN)) Q:'SRTN  D ^SROALET I '$D(SRAMAN),$D(VADM(1)) D MSG

 Q

MSG S XMSUB="RISK ASSESSMENT 30 DAY REMINDER FOR "_VADM(1),XMDUZ="SURGICAL CLINICAL NURSE REVIEWER"

 S Y=$P(^SRF(SRTN,0),"^",9),SRADATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)

 S XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""

 K SRAMSG S SRAMSG(1,0)=" ",SRAMSG(2,0)="Assesment Number: "_SRTN_"      Date of Operation: "_SRADATE,SRAMSG(3,0)="  ",SRAMSG(4,0)=SRNM,SRAMSG(5,0)=VAPA(1),SRCNT=6 I VAPA(2)'="" D ADD

 S SRAMSG(SRCNT,0)=VAPA(4)_", "_STATE_" "_VAPA(6),SRCNT=SRCNT+1

 F I=SRCNT:1:SRCNT+3 S SRAMSG(I,0)="   "

 S SEX=$P(VADM(5),"^")

 S SRAMSG(SRCNT+4,0)="It has been 25 days since "_SRNM_" had "_$S(SEX="M":"his",SEX="F":"her",1:"his")_" operation.  A follow-up ",SRAMSG(SRCNT+5,0)="letter has been printed."

 S XMTEXT="SRAMSG(" N I D ^XMD

 Q

END S SRPRINT=0 I $E(IOST)="P" S SRPRINT=1

 W:SRPRINT @IOF I $D(ZTQUEUED) Q:$G(ZTSTOP)  S ZTREQ="@" Q

 D ^%ZISC W @IOF D ^SRSKILL K SRTN,VAIN,VAINDT

 Q

ADD ; Lines 2 and 3 of street address

 S SRAMSG(6,0)=VAPA(2),SRCNT=7

 I VAPA(3)'="" S SRAMSG(7,0)=VAPA(3),SRCNT=8

 Q

SROA30    ;BIR/MAM - 30 DAY LETTERS AND MAIL MESSAGE ;01/26/06

 +1       ;;3.0; Surgery ;**7,18,31,38,95,153**;24 Jun 93;Build 11

 +2        SET SRSOUT=0

           WRITE @IOF

           KILL DIR

           SET DIR("A")="Do you want to edit the text of the letter"

           SET DIR("B")="NO"

           SET DIR(0)="Y"

           DO ^DIR

           KILL DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)

               GOTO END

 +3        IF Y

               SET X="Division: "_SRSITE("SITE")_"  ("_SRSITE("DIV")_")"

               WRITE @IOF,!,?(80-$LENGTH(X)\2),X,!

               KILL DA,DIE,DR

               SET DA=SRSITE

               SET DR="31"

               SET DIE=133

               DO ^DIE

               KILL DA,DIE,DR

ONE        IF SRSOUT

               GOTO END

           WRITE @IOF

           SET DIR("?",1)="Enter <RET> to select a patient and print the letter for a specific risk"

           SET DIR("?")="assessment, or 'NO' to print letters for a date range."

 +1        SET DIR("A")="Do you want to print the letter for a specific assessment"

           SET DIR("B")="YES"

           SET DIR(0)="Y"

           DO ^DIR

           KILL DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)

               SET SRSOUT=1

               GOTO END

 +2        IF Y

               DO ^SROASS

               IF '$DATA(SRTN)

                   SET SRSOUT=1

               IF SRSOUT

                   GOTO END

               GOTO IO

 +3        SET SRAMAN=1

 +4        WRITE !!,"This option will allow you to reprint the 30 day follow up letters for the date",!,"that they were originally printed.  When printed automatically, the letters",!,"print 25 days after the date of operation."

SDATE      WRITE !!,"Print letters for BEGINNING date: TODAY// "

           READ X:DTIME

           IF '$TEST!(X["^")

               SET SRSOUT=1

               GOTO END

 +1        IF X["?"

               WRITE !,"Enter the EARLIEST date for which you want letters printed."

               SET X="?"

               SET %DT="E"

               DO ^%DT

               GOTO SDATE

 +2        IF X=""

               SET X="T"

           SET %DT="E"

           DO ^%DT

           IF Y<1

               GOTO SDATE

           SET X1=Y

           SET X2=-25

           DO C^%DTC

           SET SRSTART=X

EDATE      WRITE !,"Print letters for ENDING date: TODAY// "

           READ X:DTIME

           IF '$TEST!(X["^")

               SET SRSOUT=1

               GOTO END

 +1        IF X["?"

               WRITE !,"Enter the LATEST date for which you want letters printed."

               SET X="?"

               SET %DT="E"

               DO ^%DT

               GOTO EDATE

 +2        IF X=""

               SET X="T"

           SET %DT="E"

           DO ^%DT

           IF Y<1

               GOTO EDATE

           SET X1=Y

           SET X2=-25

           DO C^%DTC

           SET SREND=X

 +3        IF SRSTART>SREND

               WRITE !!,"The ENDING date must be later than the BEGINNING date.  Please try again."

               GOTO SDATE

IO         IF $DATA(SRTN)

               IF $PIECE($GET(^SRF(SRTN,30)),"^")

                   WRITE !!,"The 30 Day Letter will not print because the case selected has been cancelled.",!!,"Press <RET> to continue "

                   READ X:DTIME

                   GOTO END

 +1        IF $DATA(SRTN)

               IF '$PIECE($GET(^SRF(SRTN,.2)),"^",12)

                   WRITE !!,"The 30 Day Letter will not print because for the case selected,",!,"the field, TIME PATIENT OUT OF OR, has not been filled in.",!!,"Press <RET> to continue "

                   READ X:DTIME

                   GOTO END

 +2        IF $DATA(SRTN)

               IF $PIECE($GET(^DPT(DFN,.35)),"^")

                   WRITE !!,"The 30 Day Letter will not print because the patient has a date of death.",!!,"Press <RET> to continue "

                   READ X:DTIME

                   GOTO END

 +3        WRITE !

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

           SET %ZIS("A")="Print 30 Day Letters on which Device: "

           SET %ZIS="Q"

           DO ^%ZIS

           IF POP

               SET SRSOUT=1

               GOTO END

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

               KILL IO("Q")

               SET ZTDESC="Risk Assessment 30 Day Letters"

               SET ZTSAVE("SR*")=""

               SET ZTRTN="BEG^SROA30"

               DO ^%ZTLOAD

               SET SRSOUT=1

               GOTO END

BEG       ; Entry point when manually queued

 +1        USE IO

           IF $DATA(SRTN)

               DO ^SROALET

               GOTO END

 +2        SET SRSOUT=0

           SET SRSDATE=SRSTART-.0001

           SET SREND=SREND_".9999"

           FOR 

               SET SRSDATE=$ORDER(^SRF("AC",SRSDATE))

               IF 'SRSDATE!(SRSDATE>SREND)!(SRSOUT)

                   QUIT 

               Begin DoDot:1

 +3                SET SRTN=0

                   FOR 

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

                       IF 'SRTN

                           QUIT 

                       IF $$DIV^SROUTL0(SRTN)

                           DO ^SROALET

                           IF '$DATA(SRAMAN)

                               IF $DATA(VADM(1))

                                   DO MSG

               End DoDot:1

 +4        GOTO END

EN        ; Entry point when tasked daily

 +1        IF $GET(IO)=""

               QUIT 

           USE IO

           SET (SRSOUT,SRYN)=0

 +2        SET X1=DT

           SET X2=-25

           DO C^%DTC

           SET SRSDATE=X-.0001

           SET SREND=X_".9999"

           FOR 

               SET SRSDATE=$ORDER(^SRF("AC",SRSDATE))

               IF 'SRSDATE!(SRSDATE>SREND)!(SRSOUT)

                   QUIT 

               DO SRTN

 +3        GOTO END

SRTN       IF $DATA(ZTQUEUED)

               DO ^SROSTOP

               IF SRHALT

                   SET SRSOUT=1

                   QUIT 

 +1        SET SRTN=0

           FOR 

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

               IF 'SRTN

                   QUIT 

               DO ^SROALET

               IF '$DATA(SRAMAN)

                   IF $DATA(VADM(1))

                       DO MSG

 +2        QUIT 

MSG        SET XMSUB="RISK ASSESSMENT 30 DAY REMINDER FOR "_VADM(1)

           SET XMDUZ="SURGICAL CLINICAL NURSE REVIEWER"

 +1        SET Y=$PIECE(^SRF(SRTN,0),"^",9)

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

 +2        SET XMY("G.RISK ASSESSMENT@"_^XMB("NETNAME"))=""

 +3        KILL SRAMSG

           SET SRAMSG(1,0)=" "

           SET SRAMSG(2,0)="Assesment Number: "_SRTN_"      Date of Operation: "_SRADATE

           SET SRAMSG(3,0)="  "

           SET SRAMSG(4,0)=SRNM

           SET SRAMSG(5,0)=VAPA(1)

           SET SRCNT=6

           IF VAPA(2)'=""

               DO ADD

 +4        SET SRAMSG(SRCNT,0)=VAPA(4)_", "_STATE_" "_VAPA(6)

           SET SRCNT=SRCNT+1

 +5        FOR I=SRCNT:1:SRCNT+3

               SET SRAMSG(I,0)="   "

 +6        SET SEX=$PIECE(VADM(5),"^")

 +7        SET SRAMSG(SRCNT+4,0)="It has been 25 days since "_SRNM_" had "_$SELECT(SEX="M":"his",SEX="F":"her",1:"his")_" operation.  A follow-up "

           SET SRAMSG(SRCNT+5,0)="letter has been printed."

 +8        SET XMTEXT="SRAMSG("

           NEW I

           DO ^XMD

 +9        QUIT 

END        SET SRPRINT=0

           IF $EXTRACT(IOST)="P"

               SET SRPRINT=1

 +1        IF SRPRINT

               WRITE @IOF

           IF $DATA(ZTQUEUED)

               IF $GET(ZTSTOP)

                   QUIT 

               SET ZTREQ="@"

               QUIT 

 +2        DO ^%ZISC

           WRITE @IOF

           DO ^SRSKILL

           KILL SRTN,VAIN,VAINDT

 +3        QUIT 

ADD       ; Lines 2 and 3 of street address

 +1        SET SRAMSG(6,0)=VAPA(2)

           SET SRCNT=7

 +2        IF VAPA(3)'=""

               SET SRAMSG(7,0)=VAPA(3)

               SET SRCNT=8

 +3        QUIT