APSPMED2.m

APSPMED2 ; IHS/DSD/ENM - PATIENT DEMOGRAPHICS ;  [ 09/03/97   1:30 PM ]

 ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

GET S DFN=DA D 6^VADPT,PID^VADPT

 U IO W @IOF

HDR ;EP

 S APSPAGE=APSPAGE+1 D NOW^%DTC S Y=X X ^DD("DD") W "Medication Profile",?35,Y,?65,"(Page "_APSPAGE_")"

 S APSPCN=$P($G(^AUPNPAT(DFN,41,DUZ(2),0)),U,2) W !,"Chart #: ",APSPCN

 W !,VADM(1),?40,"ID#:   "_VA("PID")

 I +VAPA(9),+VAPA(10) W !?5,"(TEMP ADDRESS from "_$P(VAPA(9),"^",2)_" till "_$P(VAPA(10),"^",2)_")"

 W !,VAPA(1),?40,"DOB:   ",$S(+VADM(3):$P(VADM(3),"^",2),1:"UNKNOWN") W:VAPA(2)]"" !,VAPA(2) W:VAPA(3)]"" !,VAPA(3)

 W !,VAPA(4),?40,"PHONE: "_VAPA(8),!,$P(VAPA(5),"^",2)_"  "_VAPA(6),?40,"ELIG:  "_$P(VAEL(1),"^",2)

 I $D(^PS(55,DFN,0)) W:$P(^(0),"^",2) !,"CANNOT USE SAFETY CAPS." I +$P(^(0),"^",4) W ?40,"DIALYSIS PATIENT."

 I $G(^PS(55,DFN,1))]"" S X=^(1) W !!?5,"Pharmacy narrative: " F I=1:1 Q:$P(X," ",I,99)=""  W $P(X," ",I)," " W:$X>75 !

RE S PSLC=0 G MA:'$D(^DPT(DFN,.17)) G MA:$P(^(.17),"^",2)'="I"

 I '$D(VAEL(1)) D ELIG^VADPT W !!,"ELIGIBILITY: ",$P(VAEL(1),"^",2) S PSLC=PSLC+2

MA K SC W !,"DISABILITIES: ",! S PSLC=PSLC+2

 F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:'I  S I1=$S($D(^(I,0)):^(0),1:""),PSDIS=$S($D(^DIC(31,+I1,0)):$P(^(0),"^"),1:""),PSCNT=$P(I1,"^",2) X:($X+$L(PSDIS)+7)>72 "W !?10 S PSLC=PSLC+1" W PSDIS,"-",PSCNT,"% (",$S($P(I1,"^",3):"SC",1:"NSC"),"), "

 X "N X S X=""GMRADPT"" X ^%ZOSF(""TEST"") Q" I $T D:'$D(PSOPTPST) GMRA

Q K SC,I1,VAROOT,Y,AL,I,X,Y,PSCNT,PSLC,PSDIS Q

GMRA W !!,"REACTIONS: " D ^GMRADPT S I1=0 F I=0:0 S I=$O(GMRAL(I)) Q:I'>0  W:I1 ", " S AL=$P(GMRAL(I),"^",2) W:$X+$L(AL)>75 !?5 W AL S I1=1

 K GMRA,GMRAL Q

APSPMED2  ; IHS/DSD/ENM - PATIENT DEMOGRAPHICS ;  [ 09/03/97   1:30 PM ]

 +1       ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97

GET        SET DFN=DA

           DO 6^VADPT

           DO PID^VADPT

 +1        USE IO

           WRITE @IOF

HDR       ;EP

 +1        SET APSPAGE=APSPAGE+1

           DO NOW^%DTC

           SET Y=X

           XECUTE ^DD("DD")

           WRITE "Medication Profile",?35,Y,?65,"(Page "_APSPAGE_")"

 +2        SET APSPCN=$PIECE($GET(^AUPNPAT(DFN,41,DUZ(2),0)),U,2)

           WRITE !,"Chart #: ",APSPCN

 +3        WRITE !,VADM(1),?40,"ID#:   "_VA("PID")

 +4        IF +VAPA(9)

               IF +VAPA(10)

                   WRITE !?5,"(TEMP ADDRESS from "_$PIECE(VAPA(9),"^",2)_" till "_$PIECE(VAPA(10),"^",2)_")"

 +5        WRITE !,VAPA(1),?40,"DOB:   ",$SELECT(+VADM(3):$PIECE(VADM(3),"^",2),1:"UNKNOWN")

           IF VAPA(2)]""

               WRITE !,VAPA(2)

           IF VAPA(3)]""

               WRITE !,VAPA(3)

 +6        WRITE !,VAPA(4),?40,"PHONE: "_VAPA(8),!,$PIECE(VAPA(5),"^",2)_"  "_VAPA(6),?40,"ELIG:  "_$PIECE(VAEL(1),"^",2)

 +7        IF $DATA(^PS(55,DFN,0))

               IF $PIECE(^(0),"^",2)

                   WRITE !,"CANNOT USE SAFETY CAPS."

               IF +$PIECE(^(0),"^",4)

                   WRITE ?40,"DIALYSIS PATIENT."

 +8        IF $GET(^PS(55,DFN,1))]""

               SET X=^(1)

               WRITE !!?5,"Pharmacy narrative: "

               FOR I=1:1

                   IF $PIECE(X," ",I,99)=""

                       QUIT 

                   WRITE $PIECE(X," ",I)," "

                   IF $X>75

                       WRITE !

RE         SET PSLC=0

           IF '$DATA(^DPT(DFN,.17))

               GOTO MA

           IF $PIECE(^(.17),"^",2)'="I"

               GOTO MA

 +1        IF '$DATA(VAEL(1))

               DO ELIG^VADPT

               WRITE !!,"ELIGIBILITY: ",$PIECE(VAEL(1),"^",2)

               SET PSLC=PSLC+2

MA         KILL SC

           WRITE !,"DISABILITIES: ",!

           SET PSLC=PSLC+2

 +1        FOR I=0:0

               SET I=$ORDER(^DPT(DFN,.372,I))

               IF 'I

                   QUIT 

               SET I1=$SELECT($DATA(^(I,0)):^(0),1:"")

               SET PSDIS=$SELECT($DATA(^DIC(31,+I1,0)):$PIECE(^(0),"^"),1:"")

               SET PSCNT=$PIECE(I1,"^",2)

               IF ($X+$LENGTH(PSDIS)+7)>72

                   XECUTE "W !?10 S PSLC=PSLC+1"

               WRITE PSDIS,"-",PSCNT,"% (",$SELECT($PIECE(I1,"^",3):"SC",1:"NSC"),"), "

 +2        XECUTE "N X S X=""GMRADPT"" X ^%ZOSF(""TEST"") Q"

           IF $TEST

               IF '$DATA(PSOPTPST)

                   DO GMRA

Q          KILL SC,I1,VAROOT,Y,AL,I,X,Y,PSCNT,PSLC,PSDIS

           QUIT 

GMRA       WRITE !!,"REACTIONS: "

           DO ^GMRADPT

           SET I1=0

           FOR I=0:0

               SET I=$ORDER(GMRAL(I))

               IF I'>0

                   QUIT 

               IF I1

                   WRITE ", "

               SET AL=$PIECE(GMRAL(I),"^",2)

               IF $X+$LENGTH(AL)>75

                   WRITE !?5

               WRITE AL

               SET I1=1

 +1        KILL GMRA,GMRAL

           QUIT