- 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
