BATLOP ; IHS/CMI/LAB - ;
;;1.0;IHS ASTHMA REGISTER;;FEB 19, 2003
;
EN ;
W:$D(IOF) @IOF
W !!,$$CTR^BATU("*** Print ASTHMA REMINDER LETTER for ONE PATIENT ***"),!!
W "This option will produce an Asthma Visit Reminder Letter that",!,"can be sent to the patient.",!!
S BATDFN=""
S DIC="^AUPNPAT(",DIC(0)="AEMQ" D ^DIC
I Y=-1 D EXIT Q
S BATDFN=+Y
W !!,$P(^DPT(BATDFN,0),U),"'s last asthma visit (visit on which asthma data",!,"elements were entered) was on ",$S($$LASTAV^BATU(BATDFN,2)]"":$$FMTE^XLFDT($$LASTAV^BATU(BATDFN,2)),1:"<<no asthma visits found>>"),".",!
W !
S DIR(0)="Y",DIR("A")="Do you still want to print a visit reminder letter",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EXIT Q
I 'Y D EXIT Q
ZIS ;
W ! S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P" K DA D ^DIR K DIR
I $D(DIRUT) D EXIT Q
S BATOPT=Y
I Y="B" D BROWSE,EXIT Q
S XBRP="PRINT^BATLOP",XBRC="",XBRX="EXIT^BATLOP",XBNS="BAT"
D ^XBDBQUE
D EXIT
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^BATLOP"")"
S XBRC="",XBRX="EXIT^BATLOP",XBIOP=0 D ^XBDBQUE
Q
PRINT ;EP
S BATAL=$O(^BATAL("B","ASTHMA VISIT REMINDER",0))
S BATPG=1 K BATQ
W:$D(IOF) @IOF
D SET(BATDFN)
S BATX=0 F S BATX=$O(^TMP($J,"ASTHMA LETTER",BATX)) Q:BATX'=+BATX!($D(BATQ)) D
.I $Y>(IOSL-3) D HEADER Q:$D(BATQ)
.W !,^TMP($J,"ASTHMA LETTER",BATX)
Q
SET(BATP) ;EP
;set up letter in ^TMP
K ^TMP($J,"ASTHMA LETTER")
S ^TMP($J,"ASTHMA LETTER",0)=0
S X="",$E(X,57)="Date: "_$$FMTE^XLFDT(DT) D S(X,1)
;write out facility and address
S X=$$CTR^BATU($P(^DIC(4,DUZ(2),0),U),80) D S(X)
S X=$$CTR^BATU($$VAL^XBDIQ1(9999999.06,DUZ(2),.14)) I X]"" D S(X)
I $P(^AUTTLOC(DUZ(2),0),U,15)]"" S X=$$CTR^BATU($$VAL^XBDIQ1(9999999.06,DUZ(2),.15)_","_" "_$$VAL^XBDIQ1(9999999.06,DUZ(2),.16)_" "_$$VAL^XBDIQ1(9999999.06,DUZ(2),.17)) D S(X)
S X=$P(^DPT(BATP,0),U) D S(X,2)
S X=$$VAL^XBDIQ1(2,BATP,.111) D S(X)
I $P($G(^DPT(BATP,11)),U,2)]"" S X=$$VAL^XBDIQ1(2,BATP,.112) D S(X)
I $P($G(^DPT(BATP,11)),U,3)]"" S X=$$VAL^XBDIQ1(2,BATP,.113) D S(X)
S X=$$VAL^XBDIQ1(2,BATP,.114)_", "_$$VAL^XBDIQ1(2,BATP,.115)_" "_$$VAL^XBDIQ1(2,BATP,.116) D S(X)
S X="Dear "_$P($P(^DPT(BATP,0),U),",",2)_" "_$P($P(^DPT(BATP,0),U),",",1)_"," D S(X,3)
S X="According to our records your last visit to the clinic for your asthma was " D S(X,2)
S X="on "_$$FMTE^XLFDT($$LASTAV^BATU(BATP,2))_"." D S(X)
S X="" D S(X)
NEW BATX
S BATX=0 F S BATX=$O(^BATAL(1,1,BATX)) Q:BATX'=+BATX S X=$G(^BATAL(1,1,BATX,0)) D S(X)
;S X="" D S(X,6)
S X="Please call "_$S($P($G(^BATSITE(DUZ(2),0)),U,4)]"":$P(^BATSITE(DUZ(2),0),U,4),1:$P(^DIC(4,DUZ(2),0),U))_" at "_$S($P($G(^BATSITE(DUZ(2),0)),U,5)]"":$P(^BATSITE(DUZ(2),0),U,5),1:$P(^AUTTLOC(DUZ(2),0),U,11))
S X=X_" to schedule" D S(X,7)
S X="your appointment." D S(X)
S X="" D S(X)
Q
S(Y,F,C,T) ;set up array
I '$G(F) S F=0
I '$G(T) S T=0
NEW %,X
;blank lines
F F=1:1:F S X="" D S1
S X=Y
I $G(C) S L=$L(Y),T=(80-L)/2 D D S1 Q
.F %=1:1:(T-1) S X=" "_X
F %=1:1:T S X=" "_Y
D S1
Q
S1 ;
S %=$P(^TMP($J,"ASTHMA LETTER",0),U)+1,$P(^TMP($J,"ASTHMA LETTER",0),U)=%
S ^TMP($J,"ASTHMA LETTER",%)=X
Q
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BATQ="" Q
HEAD1 ;
W:$D(IOF) @IOF
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
EXIT ;
D EN^XBVK("BAT")
D ^XBFMK
Q
BATLOP ; IHS/CMI/LAB - ;
+1 ;;1.0;IHS ASTHMA REGISTER;;FEB 19, 2003
+2 ;
EN ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !!,$$CTR^BATU("*** Print ASTHMA REMINDER LETTER for ONE PATIENT ***"),!!
+3 WRITE "This option will produce an Asthma Visit Reminder Letter that",!,"can be sent to the patient.",!!
+4 SET BATDFN=""
+5 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
DO ^DIC
+6 IF Y=-1
DO EXIT
QUIT
+7 SET BATDFN=+Y
+8 WRITE !!,$PIECE(^DPT(BATDFN,0),U),"'s last asthma visit (visit on which asthma data",!,"elements were entered) was on ",$SELECT($$LASTAV^BATU(BATDFN,2)]"":$$FMTE^XLFDT($$LASTAV^BATU(BATDFN,2)),1:"<<no asthma visits found>>"),".",!
+9 WRITE !
+10 SET DIR(0)="Y"
SET DIR("A")="Do you still want to print a visit reminder letter"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
DO EXIT
QUIT
+12 IF 'Y
DO EXIT
QUIT
ZIS ;
+1 WRITE !
SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"
SET DIR("A")="Do you wish to"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
DO EXIT
QUIT
+3 SET BATOPT=Y
+4 IF Y="B"
DO BROWSE
DO EXIT
QUIT
+5 SET XBRP="PRINT^BATLOP"
SET XBRC=""
SET XBRX="EXIT^BATLOP"
SET XBNS="BAT"
+6 DO ^XBDBQUE
+7 DO EXIT
+8 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^BATLOP"")"
+2 SET XBRC=""
SET XBRX="EXIT^BATLOP"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
PRINT ;EP
+1 SET BATAL=$ORDER(^BATAL("B","ASTHMA VISIT REMINDER",0))
+2 SET BATPG=1
KILL BATQ
+3 IF $DATA(IOF)
WRITE @IOF
+4 DO SET(BATDFN)
+5 SET BATX=0
FOR
SET BATX=$ORDER(^TMP($JOB,"ASTHMA LETTER",BATX))
IF BATX'=+BATX!($DATA(BATQ))
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-3)
DO HEADER
IF $DATA(BATQ)
QUIT
+7 WRITE !,^TMP($JOB,"ASTHMA LETTER",BATX)
End DoDot:1
+8 QUIT
SET(BATP) ;EP
+1 ;set up letter in ^TMP
+2 KILL ^TMP($JOB,"ASTHMA LETTER")
+3 SET ^TMP($JOB,"ASTHMA LETTER",0)=0
+4 SET X=""
SET $EXTRACT(X,57)="Date: "_$$FMTE^XLFDT(DT)
DO S(X,1)
+5 ;write out facility and address
+6 SET X=$$CTR^BATU($PIECE(^DIC(4,DUZ(2),0),U),80)
DO S(X)
+7 SET X=$$CTR^BATU($$VAL^XBDIQ1(9999999.06,DUZ(2),.14))
IF X]""
DO S(X)
+8 IF $PIECE(^AUTTLOC(DUZ(2),0),U,15)]""
SET X=$$CTR^BATU($$VAL^XBDIQ1(9999999.06,DUZ(2),.15)_","_" "_$$VAL^XBDIQ1(9999999.06,DUZ(2),.16)_" "_$$VAL^XBDIQ1(9999999.06,DUZ(2),.17))
DO S(X)
+9 SET X=$PIECE(^DPT(BATP,0),U)
DO S(X,2)
+10 SET X=$$VAL^XBDIQ1(2,BATP,.111)
DO S(X)
+11 IF $PIECE($GET(^DPT(BATP,11)),U,2)]""
SET X=$$VAL^XBDIQ1(2,BATP,.112)
DO S(X)
+12 IF $PIECE($GET(^DPT(BATP,11)),U,3)]""
SET X=$$VAL^XBDIQ1(2,BATP,.113)
DO S(X)
+13 SET X=$$VAL^XBDIQ1(2,BATP,.114)_", "_$$VAL^XBDIQ1(2,BATP,.115)_" "_$$VAL^XBDIQ1(2,BATP,.116)
DO S(X)
+14 SET X="Dear "_$PIECE($PIECE(^DPT(BATP,0),U),",",2)_" "_$PIECE($PIECE(^DPT(BATP,0),U),",",1)_","
DO S(X,3)
+15 SET X="According to our records your last visit to the clinic for your asthma was "
DO S(X,2)
+16 SET X="on "_$$FMTE^XLFDT($$LASTAV^BATU(BATP,2))_"."
DO S(X)
+17 SET X=""
DO S(X)
+18 NEW BATX
+19 SET BATX=0
FOR
SET BATX=$ORDER(^BATAL(1,1,BATX))
IF BATX'=+BATX
QUIT
SET X=$GET(^BATAL(1,1,BATX,0))
DO S(X)
+20 ;S X="" D S(X,6)
+21 SET X="Please call "_$SELECT($PIECE($GET(^BATSITE(DUZ(2),0)),U,4)]"":$PIECE(^BATSITE(DUZ(2),0),U,4),1:$PIECE(^DIC(4,DUZ(2),0),U))_" at "_$SELECT($PIECE($GET(^BATSITE(DUZ(2),0)),U,5)]"":$PIECE(^BATSITE(DUZ(2),0),U,5),1:$PIECE(^AUTTLOC(DUZ(2),0),
U,11))
+22 SET X=X_" to schedule"
DO S(X,7)
+23 SET X="your appointment."
DO S(X)
+24 SET X=""
DO S(X)
+25 QUIT
S(Y,F,C,T) ;set up array
+1 IF '$GET(F)
SET F=0
+2 IF '$GET(T)
SET T=0
+3 NEW %,X
+4 ;blank lines
+5 FOR F=1:1:F
SET X=""
DO S1
+6 SET X=Y
+7 IF $GET(C)
SET L=$LENGTH(Y)
SET T=(80-L)/2
Begin DoDot:1
+8 FOR %=1:1:(T-1)
SET X=" "_X
End DoDot:1
DO S1
QUIT
+9 FOR %=1:1:T
SET X=" "_Y
+10 DO S1
+11 QUIT
S1 ;
+1 SET %=$PIECE(^TMP($JOB,"ASTHMA LETTER",0),U)+1
SET $PIECE(^TMP($JOB,"ASTHMA LETTER",0),U)=%
+2 SET ^TMP($JOB,"ASTHMA LETTER",%)=X
+3 QUIT
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BATQ=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
EXIT ;
+1 DO EN^XBVK("BAT")
+2 DO ^XBFMK
+3 QUIT
