BATLOP.m

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

HEADER ;

 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 

HEADER    ;

 +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