APCHPMH3.m

APCHPMH3 ; IHS/CMI/LAB - Patient Wellness Handout ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

 ;

 ;

MEDS ;EP - DISPLAY MEDS

 ;Suppress original text per Chris Lamer 11/29/07 *17*

 ;S X="Medicines are important - it helps to know" D S(X,1)

 ;S X="",$E(X,5)="Why you will take it?" D S(X,1)  ;*17*

 ;S X="",$E(X,5)="When to take it?" D S(X)

 ;S X="",$E(X,5)="How much to take?"  D S(X)

 ;S X="",$E(X,5)="What to do if you forget to take it?"  D S(X)

 ;S X="",$E(X,5)="What could happen if you forget or take too much."  D S(X)

 ;S X="Knowing these things will help the medicine work best for you." D S(X,1)  ;*17*

 S X="Medications - here is a list of the medicines you are taking:"  D S(X,1)

 S X="" D S(X)

 ;

 ;get all "active" meds

 S APCHSDLM=$$FMADD^XLFDT(DT,-365),APCHSDLM=9999999-APCHSDLM

 S APCHSIVD=0,APCHSMCT=0 F APCHSQ=0:0 S APCHSIVD=$O(^AUPNVMED("AA",APCHSDFN,APCHSIVD)) Q:APCHSIVD=""!(APCHSIVD>APCHSDLM)  S APCHSMX=0 F APCHSQ=0:0 S APCHSMX=$O(^AUPNVMED("AA",APCHSDFN,APCHSIVD,APCHSMX)) Q:APCHSMX=""  D MEDBLD

 I $G(APCHSMCT)=0 S X="",$E(X,5)="No current meds on file" D S(X)

 S APCHSMED=""

 F  S APCHSMED=$O(APCHSM(APCHSMED)) Q:$G(APCHSMED)']""  D

 .S X="",$E(X,5)=APCHSMED D S(X)

 .K ^UTILITY($J,"W") S APCHSIG=$P($G(APCHSM(APCHSMED)),U,5),X=APCHSIG,DIWL=0,DIWR=58 D ^DIWP

 .S X="",$E(X,7)="Directions: "_$S($L($G(^UTILITY($J,"W",0,1,0)))>1:$G(^UTILITY($J,"W",0,1,0)),$L($G(^UTILITY($J,"W",0,1,0)))=1:"No directions on file",1:" ") D S(X)

 .I $G(^UTILITY($J,"W",0))>1 F I=2:1:$G(^UTILITY($J,"W",0)) S X="",$E(X,7)=$G(^UTILITY($J,"W",0,I,0)) D S(X)

 .K ^UTILITY($J,"W")

 .Q

 D HOLD

 I '$D(APCHHM) Q

 S X="Medications ordered, but not yet dispensed" D S(X,1)

 S X="" D S(X)

 S APCHHMED=""

 F  S APCHHMED=$O(APCHHM(APCHHMED)) Q:$G(APCHHMED)']""  D

 .S X="",$E(X,5)=APCHHMED D S(X)

 Q

MEDBLD ;BUILD ARRAY OF MEDICATIONS 

 ;

 K APCHSRXP,APCHSCOT

 Q:'$D(^AUPNVMED(APCHSMX,0))

 S APCHSN=^AUPNVMED(APCHSMX,0)

 Q:'$D(^PSDRUG($P(APCHSN,U,1)))

 S APCHSDTM=-APCHSIVD\1+9999999  ;Visit date from V Med .03 field

 Q:$P(APCHSN,U,8)]""  ;date discontinued

 S APCHSRXP=$S($D(^PSRX("APCC",APCHSMX)):$O(^(APCHSMX,0)),1:0)  ;RX IEN

 I APCHSRXP>0 S RX0=^PSRX(APCHSRXP,0),RX2=^PSRX(APCHSRXP,2) I '$D(^PSRX(APCHSRXP,"STA")) D RXSTAT Q:ST="EXPIRED"!(ST="CANCELLED")!(ST="DELETED")  ;CALCULATE RX STATUS IF V6

 I $G(APCHSRXP)'>0 S APCHSCOT=1  ;may be using COTS or med entered via PCC data entry

 I $P($G(^AUPNVMED(APCHSMX,12)),U,9)]"" S APCHSCOT=1  ;external key present

 S APCHSSTA=$P($G(^PSRX(APCHSRXP,0)),U,15)  ;Active? RX File status

 Q:$G(APCHSSTA)>10  ;status is expired, deleted or cancelled

 I $G(^PSRX(APCHSRXP,"STA"))>10 Q  ;Status is in "STA" node in V 7

 I $G(^PSRX(APCHSRXP,"STA"))=1 Q  ;NON-VERIFIED

 I $G(^PSRX(APCHSRXP,"STA"))=4 Q  ;DRUG INTERACTION

 S APCHSIG=""

 S APCHSIG=$P($G(APCHSN),U,5)

 D SIG  ;get expanded sig

 S APCHSDYS=$P($G(APCHSN),U,7)  ;days supply

 ;Q:APCHSDYS=1  ;quit if only 1 day supply

 I $G(APCHSCOT)=1,$G(APCHSDYS)]"",$$FMDIFF^XLFDT(DT,APCHSDTM)>$G(APCHSDYS) Q

 ;Q:$P($G(^AUPNVMED(APCHSMX,0)),U,6)=1  ;quit if qty=1

 I $P($G(^AUPNVMED(APCHSMX,0)),U,6)=1,APCHSDYS=1 Q  ;quit if qty=1 AND days supply=1  **17**

 S APCHSMFX=$P(^PSDRUG(+APCHSN,0),U)  D  ;compare Drug File .01 field & V Med Name of Non Table Drug

 .Q:$P(APCHSN,U,4)=""

 .I $P($G(APCHSN),U,4)]"",$P($G(APCHSN),U,4)=$P(^PSDRUG(+APCHSN,0),U) Q

 .I $P($G(APCHSN),U,4)]"",$P($G(APCHSN),U,4)'=$P(^PSDRUG(+APCHSN,0),U) S APCHSMFX=$P(APCHSN,U,4)

 .Q

 I $G(APCHSM(APCHSMFX)) Q  ;quit if med already exists

 S APCHSM(APCHSMFX)=+APCHSN_U_APCHSDYS  ;PSDRUG ien^days supply

 I $G(APCHSRXP)>0 S $P(APCHSM(APCHSMFX),U,3)=APCHSRXP  ;^PSRX ien

 S $P(APCHSM(APCHSMFX),U,4)=$G(ST)  ;status from RXSTAT

 S $P(APCHSM(APCHSMFX),U,5)=$G(APCHSSGY)

 S APCHSMCT=APCHSMCT+1  ;number of active meds

 Q

 ;

RXSTAT ;gets status of rx ... TAKEN FROM PSOFUNC ROUTINE

 Q:$D(^PSRX(APCHSRXP,"STA"))  ;USING V7

 Q:$G(APCHSRXP)'>0

 S J=APCHSRXP

 S ST0=+$P(RX0,"^",15) I ST0<12,$O(^PS(52.5,"B",J,0)),$D(^PS(52.5,+$O(^(0)),0)),'$G(^("P")) S ST0=5

 I ST0<12,$P(RX2,"^",6),$P(RX2,"^",6)'>DT S ST0=11

 S ST=$P("ERROR^ACTIVE^NON-VERIFIED^REFILL FILL^HOLD^PENDING DUE TO DRUG INTERACTION^SUSPENDED^^^^^DONE^EXPIRED^CANCELLED^DELETED","^",ST0+2),$P(RX0,"^",15)=ST0

 Q

 ;S ST0=+$P(RX0,"^",15) I ST0<12,$O(^PS(52.5,"B",J,0)),$D(^PS(52.5,+$O(^(0)),0)),'$G(^("P")) S ST0=5

 ;I ST0<12,$P(RX2,"^",6)<DT S ST0=11

 ;S ST=$P("Error^Active^Non-Verified^Refill^Hold^Non-Verified^Suspended^^^^^Done^Expired^Discontinued^Deleted^Discontinued^Discontinued (Edit)^Provider Hold^","^",ST0+2),$P(RX0,"^",15)=ST0

 ;Q

HOLD ;Now get meds in Pharmacy yet to be completed

 Q:'APCHSDFN

 S APCHSDT=DT

 F  S APCHSDT=$O(^PS(55,APCHSDFN,"P","A",APCHSDT)) Q:APCHSDT'=+APCHSDT  D

 .S APCHNMED=0 F  S APCHNMED=$O(^PS(55,APCHSDFN,"P","A",APCHSDT,APCHNMED)) Q:'APCHNMED  D

 ..I $G(^PSRX(APCHNMED,"STA"))=3!($G(^PSRX(APCHNMED,"STA"))=5) D

 ...S APCHHMED=$P(^PSRX(APCHNMED,0),U,6) I $G(APCHHMED)]"" S APCHHMED=$P(^PSDRUG(APCHHMED,0),U)

 ...S APCHHM(APCHHMED)=APCHNMED

 ..Q

 Q

 ; 

SIG ;CONSTRUCT THE FULL TEXT FROM THE ENCODED SIG

 S APCHSSGY="" F APCHSP=1:1:$L(APCHSIG," ") S X=$P(APCHSIG," ",APCHSP) I X]"" D

 . S Y=$O(^PS(51,"B",X,0)) I Y>0 S X=$P(^PS(51,Y,0),"^",2) I $D(^(9)) S Y=$P(APCHSIG," ",APCHSP-1),Y=$E(Y,$L(Y)) S:Y>1 X=$P(^(9),"^",1)

 . S APCHSSGY=APCHSSGY_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("APCHPHS",$J,"PMH",0),U)+1,$P(^TMP("APCHPHS",$J,"PMH",0),U)=%

 S ^TMP("APCHPHS",$J,"PMH",%)=X

 Q

DATE(D) ;EP - convert to slashed date

 I $G(D)="" Q ""

 Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)

 ;

 ;

CLOSE ;EP - Write closing statement per Chris Lamer 11/29/07 *17*

 ;

 S X="* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *" D S(X,1)

 S X="",$E(X,5)="This handout is yours to keep and contains information that is in your" D S(X)

 S X="",$E(X,5)="medical record (your chart).  You can keep this handout for your records" D S(X)

 S X="",$E(X,5)="or share the information with other health care workers.  Please let us" D S(X)

 S X="",$E(X,5)="know if anything is wrong or missing from your handout - we want to be" D S(X)

 S X="",$E(X,5)="sure it is correct."  D S(X)

 S X="",$E(X,5)="Thank you and have a healthy day!" D S(X,1)

 Q

APCHPMH3  ; IHS/CMI/LAB - Patient Wellness Handout ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

 +3       ;

 +4       ;

MEDS      ;EP - DISPLAY MEDS

 +1       ;Suppress original text per Chris Lamer 11/29/07 *17*

 +2       ;S X="Medicines are important - it helps to know" D S(X,1)

 +3       ;S X="",$E(X,5)="Why you will take it?" D S(X,1)  ;*17*

 +4       ;S X="",$E(X,5)="When to take it?" D S(X)

 +5       ;S X="",$E(X,5)="How much to take?"  D S(X)

 +6       ;S X="",$E(X,5)="What to do if you forget to take it?"  D S(X)

 +7       ;S X="",$E(X,5)="What could happen if you forget or take too much."  D S(X)

 +8       ;S X="Knowing these things will help the medicine work best for you." D S(X,1)  ;*17*

 +9        SET X="Medications - here is a list of the medicines you are taking:"

           DO S(X,1)

 +10       SET X=""

           DO S(X)

 +11      ;

 +12      ;get all "active" meds

 +13       SET APCHSDLM=$$FMADD^XLFDT(DT,-365)

           SET APCHSDLM=9999999-APCHSDLM

 +14       SET APCHSIVD=0

           SET APCHSMCT=0

           FOR APCHSQ=0:0

               SET APCHSIVD=$ORDER(^AUPNVMED("AA",APCHSDFN,APCHSIVD))

               IF APCHSIVD=""!(APCHSIVD>APCHSDLM)

                   QUIT 

               SET APCHSMX=0

               FOR APCHSQ=0:0

                   SET APCHSMX=$ORDER(^AUPNVMED("AA",APCHSDFN,APCHSIVD,APCHSMX))

                   IF APCHSMX=""

                       QUIT 

                   DO MEDBLD

 +15       IF $GET(APCHSMCT)=0

               SET X=""

               SET $EXTRACT(X,5)="No current meds on file"

               DO S(X)

 +16       SET APCHSMED=""

 +17       FOR 

               SET APCHSMED=$ORDER(APCHSM(APCHSMED))

               IF $GET(APCHSMED)']""

                   QUIT 

               Begin DoDot:1

 +18               SET X=""

                   SET $EXTRACT(X,5)=APCHSMED

                   DO S(X)

 +19               KILL ^UTILITY($JOB,"W")

                   SET APCHSIG=$PIECE($GET(APCHSM(APCHSMED)),U,5)

                   SET X=APCHSIG

                   SET DIWL=0

                   SET DIWR=58

                   DO ^DIWP

 +20               SET X=""

                   SET $EXTRACT(X,7)="Directions: "_$SELECT($LENGTH($GET(^UTILITY($JOB,"W",0,1,0)))>1:$GET(^UTILITY($JOB,"W",0,1,0)),$LENGTH($GET(^UTILITY($JOB,"W",0,1,0)))=1:"No directions on file",1:" ")

                   DO S(X)

 +21               IF $GET(^UTILITY($JOB,"W",0))>1

                       FOR I=2:1:$GET(^UTILITY($JOB,"W",0))

                           SET X=""

                           SET $EXTRACT(X,7)=$GET(^UTILITY($JOB,"W",0,I,0))

                           DO S(X)

 +22               KILL ^UTILITY($JOB,"W")

 +23               QUIT 

               End DoDot:1

 +24       DO HOLD

 +25       IF '$DATA(APCHHM)

               QUIT 

 +26       SET X="Medications ordered, but not yet dispensed"

           DO S(X,1)

 +27       SET X=""

           DO S(X)

 +28       SET APCHHMED=""

 +29       FOR 

               SET APCHHMED=$ORDER(APCHHM(APCHHMED))

               IF $GET(APCHHMED)']""

                   QUIT 

               Begin DoDot:1

 +30               SET X=""

                   SET $EXTRACT(X,5)=APCHHMED

                   DO S(X)

               End DoDot:1

 +31       QUIT 

MEDBLD    ;BUILD ARRAY OF MEDICATIONS 

 +1       ;

 +2        KILL APCHSRXP,APCHSCOT

 +3        IF '$DATA(^AUPNVMED(APCHSMX,0))

               QUIT 

 +4        SET APCHSN=^AUPNVMED(APCHSMX,0)

 +5        IF '$DATA(^PSDRUG($PIECE(APCHSN,U,1)))

               QUIT 

 +6       ;Visit date from V Med .03 field

           SET APCHSDTM=-APCHSIVD\1+9999999

 +7       ;date discontinued

           IF $PIECE(APCHSN,U,8)]""

               QUIT 

 +8       ;RX IEN

           SET APCHSRXP=$SELECT($DATA(^PSRX("APCC",APCHSMX)):$ORDER(^(APCHSMX,0)),1:0)

 +9       ;CALCULATE RX STATUS IF V6

           IF APCHSRXP>0

               SET RX0=^PSRX(APCHSRXP,0)

               SET RX2=^PSRX(APCHSRXP,2)

               IF '$DATA(^PSRX(APCHSRXP,"STA"))

                   DO RXSTAT

                   IF ST="EXPIRED"!(ST="CANCELLED")!(ST="DELETED")

                       QUIT 

 +10      ;may be using COTS or med entered via PCC data entry

           IF $GET(APCHSRXP)'>0

               SET APCHSCOT=1

 +11      ;external key present

           IF $PIECE($GET(^AUPNVMED(APCHSMX,12)),U,9)]""

               SET APCHSCOT=1

 +12      ;Active? RX File status

           SET APCHSSTA=$PIECE($GET(^PSRX(APCHSRXP,0)),U,15)

 +13      ;status is expired, deleted or cancelled

           IF $GET(APCHSSTA)>10

               QUIT 

 +14      ;Status is in "STA" node in V 7

           IF $GET(^PSRX(APCHSRXP,"STA"))>10

               QUIT 

 +15      ;NON-VERIFIED

           IF $GET(^PSRX(APCHSRXP,"STA"))=1

               QUIT 

 +16      ;DRUG INTERACTION

           IF $GET(^PSRX(APCHSRXP,"STA"))=4

               QUIT 

 +17       SET APCHSIG=""

 +18       SET APCHSIG=$PIECE($GET(APCHSN),U,5)

 +19      ;get expanded sig

           DO SIG

 +20      ;days supply

           SET APCHSDYS=$PIECE($GET(APCHSN),U,7)

 +21      ;Q:APCHSDYS=1  ;quit if only 1 day supply

 +22       IF $GET(APCHSCOT)=1

               IF $GET(APCHSDYS)]""

                   IF $$FMDIFF^XLFDT(DT,APCHSDTM)>$GET(APCHSDYS)

                       QUIT 

 +23      ;Q:$P($G(^AUPNVMED(APCHSMX,0)),U,6)=1  ;quit if qty=1

 +24      ;quit if qty=1 AND days supply=1  **17**

           IF $PIECE($GET(^AUPNVMED(APCHSMX,0)),U,6)=1

               IF APCHSDYS=1

                   QUIT 

 +25      ;compare Drug File .01 field & V Med Name of Non Table Drug

           SET APCHSMFX=$PIECE(^PSDRUG(+APCHSN,0),U)

           Begin DoDot:1

 +26           IF $PIECE(APCHSN,U,4)=""

                   QUIT 

 +27           IF $PIECE($GET(APCHSN),U,4)]""

                   IF $PIECE($GET(APCHSN),U,4)=$PIECE(^PSDRUG(+APCHSN,0),U)

                       QUIT 

 +28           IF $PIECE($GET(APCHSN),U,4)]""

                   IF $PIECE($GET(APCHSN),U,4)'=$PIECE(^PSDRUG(+APCHSN,0),U)

                       SET APCHSMFX=$PIECE(APCHSN,U,4)

 +29           QUIT 

           End DoDot:1

 +30      ;quit if med already exists

           IF $GET(APCHSM(APCHSMFX))

               QUIT 

 +31      ;PSDRUG ien^days supply

           SET APCHSM(APCHSMFX)=+APCHSN_U_APCHSDYS

 +32      ;^PSRX ien

           IF $GET(APCHSRXP)>0

               SET $PIECE(APCHSM(APCHSMFX),U,3)=APCHSRXP

 +33      ;status from RXSTAT

           SET $PIECE(APCHSM(APCHSMFX),U,4)=$GET(ST)

 +34       SET $PIECE(APCHSM(APCHSMFX),U,5)=$GET(APCHSSGY)

 +35      ;number of active meds

           SET APCHSMCT=APCHSMCT+1

 +36       QUIT 

 +37      ;

RXSTAT    ;gets status of rx ... TAKEN FROM PSOFUNC ROUTINE

 +1       ;USING V7

           IF $DATA(^PSRX(APCHSRXP,"STA"))

               QUIT 

 +2        IF $GET(APCHSRXP)'>0

               QUIT 

 +3        SET J=APCHSRXP

 +4        SET ST0=+$PIECE(RX0,"^",15)

           IF ST0<12

               IF $ORDER(^PS(52.5,"B",J,0))

                   IF $DATA(^PS(52.5,+$ORDER(^(0)),0))

                       IF '$GET(^("P"))

                           SET ST0=5

 +5        IF ST0<12

               IF $PIECE(RX2,"^",6)

                   IF $PIECE(RX2,"^",6)'>DT

                       SET ST0=11

 +6        SET ST=$PIECE("ERROR^ACTIVE^NON-VERIFIED^REFILL FILL^HOLD^PENDING DUE TO DRUG INTERACTION^SUSPENDED^^^^^DONE^EXPIRED^CANCELLED^DELETED","^",ST0+2)

           SET $PIECE(RX0,"^",15)=ST0

 +7        QUIT 

 +8       ;S ST0=+$P(RX0,"^",15) I ST0<12,$O(^PS(52.5,"B",J,0)),$D(^PS(52.5,+$O(^(0)),0)),'$G(^("P")) S ST0=5

 +9       ;I ST0<12,$P(RX2,"^",6)<DT S ST0=11

 +10      ;S ST=$P("Error^Active^Non-Verified^Refill^Hold^Non-Verified^Suspended^^^^^Done^Expired^Discontinued^Deleted^Discontinued^Discontinued (Edit)^Provider Hold^","^",ST0+2),$P(RX0,"^",15)=ST0

 +11      ;Q

HOLD      ;Now get meds in Pharmacy yet to be completed

 +1        IF 'APCHSDFN

               QUIT 

 +2        SET APCHSDT=DT

 +3        FOR 

               SET APCHSDT=$ORDER(^PS(55,APCHSDFN,"P","A",APCHSDT))

               IF APCHSDT'=+APCHSDT

                   QUIT 

               Begin DoDot:1

 +4                SET APCHNMED=0

                   FOR 

                       SET APCHNMED=$ORDER(^PS(55,APCHSDFN,"P","A",APCHSDT,APCHNMED))

                       IF 'APCHNMED

                           QUIT 

                       Begin DoDot:2

 +5                        IF $GET(^PSRX(APCHNMED,"STA"))=3!($GET(^PSRX(APCHNMED,"STA"))=5)

                               Begin DoDot:3

 +6                                SET APCHHMED=$PIECE(^PSRX(APCHNMED,0),U,6)

                                   IF $GET(APCHHMED)]""

                                       SET APCHHMED=$PIECE(^PSDRUG(APCHHMED,0),U)

 +7                                SET APCHHM(APCHHMED)=APCHNMED

                               End DoDot:3

 +8                        QUIT 

                       End DoDot:2

               End DoDot:1

 +9        QUIT 

 +10      ; 

SIG       ;CONSTRUCT THE FULL TEXT FROM THE ENCODED SIG

 +1        SET APCHSSGY=""

           FOR APCHSP=1:1:$LENGTH(APCHSIG," ")

               SET X=$PIECE(APCHSIG," ",APCHSP)

               IF X]""

                   Begin DoDot:1

 +2                    SET Y=$ORDER(^PS(51,"B",X,0))

                       IF Y>0

                           SET X=$PIECE(^PS(51,Y,0),"^",2)

                           IF $DATA(^(9))

                               SET Y=$PIECE(APCHSIG," ",APCHSP-1)

                               SET Y=$EXTRACT(Y,$LENGTH(Y))

                               IF Y>1

                                   SET X=$PIECE(^(9),"^",1)

 +3                    SET APCHSSGY=APCHSSGY_X_" "

                   End DoDot:1

 +4        QUIT 

 +5       ; 

 +6       ; 

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("APCHPHS",$JOB,"PMH",0),U)+1

           SET $PIECE(^TMP("APCHPHS",$JOB,"PMH",0),U)=%

 +2        SET ^TMP("APCHPHS",$JOB,"PMH",%)=X

 +3        QUIT 

DATE(D)   ;EP - convert to slashed date

 +1        IF $GET(D)=""

               QUIT ""

 +2        QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)

 +3       ;

 +4       ;

CLOSE     ;EP - Write closing statement per Chris Lamer 11/29/07 *17*

 +1       ;

 +2        SET X="* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"

           DO S(X,1)

 +3        SET X=""

           SET $EXTRACT(X,5)="This handout is yours to keep and contains information that is in your"

           DO S(X)

 +4        SET X=""

           SET $EXTRACT(X,5)="medical record (your chart).  You can keep this handout for your records"

           DO S(X)

 +5        SET X=""

           SET $EXTRACT(X,5)="or share the information with other health care workers.  Please let us"

           DO S(X)

 +6        SET X=""

           SET $EXTRACT(X,5)="know if anything is wrong or missing from your handout - we want to be"

           DO S(X)

 +7        SET X=""

           SET $EXTRACT(X,5)="sure it is correct."

           DO S(X)

 +8        SET X=""

           SET $EXTRACT(X,5)="Thank you and have a healthy day!"

           DO S(X,1)

 +9        QUIT