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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROA30 4258 printed Dec 13, 2024@02:39:50 Page 2
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
