- PSODEM ;BHAM ISC/SAB - PATIENT DEMOGRAPHICS ;30-Oct-2013 23:38;PLS
- ;;7.0;OUTPATIENT PHARMACY;**5,19,233,258,326,1015,1016**;DEC 1997;Build 74
- ; Modified - IHS/CIA/PLS - 12/23/03 - Line RE
- ; IHS/MSC/PLS - 10/31/13 - Added ID# back after patch 326
- GET S DFN=DA D 6^VADPT,PID^VADPT U IO W @IOF,!,VADM(1),?40,"ID#: "_VA("PID")
- I +VAPA(9) W !?5,"(TEMP ADDRESS from "_$P(VAPA(9),"^",2)_" till "_$S($P(VAPA(10),"^",2)]"":$P(VAPA(10),"^",2),1:"(no end date)")_")"
- 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)_" "_$S(VAPA(11)]"":$P(VAPA(11),"^",2),1:VAPA(6)),?40,"ELIG: "_$P(VAEL(1),"^",2) W:+VAEL(3) !?40,"SC%: "_$P(VAEL(3),"^",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:$X+$L($P(X," ",I))+$L(" ")>IOM ! W $P(X," ",I)," "
- RE ; IHS/CIA/PLS - 12/11/03 - Changed to call PCC Vitals
- S (WT,HT)="" ;,X="GMRVUTL" X ^%ZOSF("TEST") I $T D
- ;.F GMRVSTR="WT","HT" S VM=GMRVSTR D EN6^GMRVUTL S @VM=X,$P(@VM,"^")=$E($P(@VM,"^"),4,5)_"/"_$E($P(@VM,"^"),6,7)_"/"_($E($P(@VM,"^"),1,3)+1700)
- ;.S X=$P(WT,"^",8),Y=$J(X/2.2,0,2),$P(WT,"^",9)=Y,X=$P(HT,"^",8),Y=$J(2.54*X,0,2),$P(HT,"^",9)=Y
- S WT=$$VITALF^APSPFUNC(DFN,"WT"),$P(WT,U,9)=$$VITCWT^APSPFUNC($P(WT,U,8))
- S HT=$$VITALF^APSPFUNC(DFN,"HT"),$P(HT,U,9)=$$VITCHT^APSPFUNC($P(HT,U,8))
- Q:$G(POERR)
- W !!,"WEIGHT(Kg): " W:+$P(WT,"^",8) $P(WT,"^",9)_" ("_$P(WT,"^")_")" W ?41,"HEIGHT(cm): " W:$P(HT,"^",8) $P(HT,"^",9)_" ("_$P(HT,"^")_")" K VM,WT,HT
- S PSLC=0 G MA:$P($G(^DPT(DFN,.17)),"^",2)'="I"
- I '$D(VAEL(1)) D ELIG^VADPT W !!,"ELIGIBILITY: ",$P(VAEL(1),"^",2) W:+VAEL(3) ?$X+5,"SC%: "_$P(VAEL(3),"^",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(^DPT(DFN,.372,I,0)):^(0),1:"") D:+I1
- .S PSDIS=$S($P($G(^DIC(31,+I1,0)),"^")]""&($P($G(^(0)),"^",4)']""):$P(^(0),"^"),$P($G(^DIC(31,+I1,0)),"^",4)]"":$P(^(0),"^",4),1:""),PSCNT=$P(I1,"^",2)
- .X:($X+$L(PSDIS)+7)>(IOM-8) "W !?14 S PSLC=PSLC+1" W PSDIS,"-",PSCNT,"% (",$S($P(I1,"^",3):"SC",1:"NSC"),"), "
- .I $E(IOST)="C",$Y+4>IOSL,$D(PSTYPE) K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DTOUT W @IOF,?13
- 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 D:$G(PSTYPE)']"" KVA^VADPT Q
- GMRA K ^TMP($J,"AL") S GMRA="0^0^111" D ^GMRADPT I GMRAL D
- .F DR=0:0 S DR=$O(GMRAL(DR)) Q:'DR S ^TMP($J,"AL",$S('$P(GMRAL(DR),"^",5):1,1:2),$P(GMRAL(DR),"^",7),$P(GMRAL(DR),"^",2))=""
- .W !!,"ALLERGIES: " S (DR,TY)="" F I=0:0 S TY=$O(^TMP($J,"AL",1,TY)) Q:TY="" F D=0:0 S DR=$O(^TMP($J,"AL",1,TY,DR)) Q:DR="" W:$X+$L(DR)+$L(", ")>IOM !?11 W DR_", " D
- ..I $E(IOST)="C",$Y+4>IOSL,$D(PSTYPE) W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DTOUT W @IOF,?18
- .W !!,"ADVERSE REACTIONS: " S (DR,TY)="" F I=0:0 S TY=$O(^TMP($J,"AL",2,TY)) Q:TY="" F D=0:0 S DR=$O(^TMP($J,"AL",2,TY,DR)) Q:DR="" W:$X+$L(DR)+$L(", ")>IOM !?19 W DR_", " D
- ..I $E(IOST)="C",$Y+4>IOSL,$D(PSTYPE) W ! K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DTOUT W @IOF,?18
- I $G(GMRAL)']"" F AD="ALLERGIES:","ADVERSE REACTIONS:" W !!,AD I $G(PSOFROM)="" F ADL=1:1:IOM-($L(AD)+5) W "_"
- I GMRAL=0 W !!,"ALLERGIES: NKA",!!,"ADVERSE REACTIONS:"
- W ! K TY,D,I,GMRA,GMRAL,DR,AD,ADL,^TMP($J,"AL") Q
- PSODEM ;BHAM ISC/SAB - PATIENT DEMOGRAPHICS ;30-Oct-2013 23:38;PLS
- +1 ;;7.0;OUTPATIENT PHARMACY;**5,19,233,258,326,1015,1016**;DEC 1997;Build 74
- +2 ; Modified - IHS/CIA/PLS - 12/23/03 - Line RE
- +3 ; IHS/MSC/PLS - 10/31/13 - Added ID# back after patch 326
- GET SET DFN=DA
- DO 6^VADPT
- DO PID^VADPT
- USE IO
- WRITE @IOF,!,VADM(1),?40,"ID#: "_VA("PID")
- +1 IF +VAPA(9)
- WRITE !?5,"(TEMP ADDRESS from "_$PIECE(VAPA(9),"^",2)_" till "_$SELECT($PIECE(VAPA(10),"^",2)]"":$PIECE(VAPA(10),"^",2),1:"(no end date)")_")"
- +2 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)
- +3 WRITE !,VAPA(4),?40,"PHONE: "_VAPA(8),!,$PIECE(VAPA(5),"^",2)_" "_$SELECT(VAPA(11)]"":$PIECE(VAPA(11),"^",2),1:VAPA(6)),?40,"ELIG: "_$PIECE(VAEL(1),"^",2)
- IF +VAEL(3)
- WRITE !?40,"SC%: "_$PIECE(VAEL(3),"^",2)
- +4 IF $DATA(^PS(55,DFN,0))
- IF $PIECE(^(0),"^",2)
- WRITE !,"CANNOT USE SAFETY CAPS."
- IF +$PIECE(^(0),"^",4)
- WRITE ?40,"DIALYSIS PATIENT."
- +5 IF $GET(^PS(55,DFN,1))]""
- SET X=^(1)
- WRITE !!?5,"Pharmacy Narrative: "
- FOR I=1:1
- IF $PIECE(X," ",I,99)=""
- QUIT
- IF $X+$LENGTH($PIECE(X," ",I))+$LENGTH(" ")>IOM
- WRITE !
- WRITE $PIECE(X," ",I)," "
- RE ; IHS/CIA/PLS - 12/11/03 - Changed to call PCC Vitals
- +1 ;,X="GMRVUTL" X ^%ZOSF("TEST") I $T D
- SET (WT,HT)=""
- +2 ;.F GMRVSTR="WT","HT" S VM=GMRVSTR D EN6^GMRVUTL S @VM=X,$P(@VM,"^")=$E($P(@VM,"^"),4,5)_"/"_$E($P(@VM,"^"),6,7)_"/"_($E($P(@VM,"^"),1,3)+1700)
- +3 ;.S X=$P(WT,"^",8),Y=$J(X/2.2,0,2),$P(WT,"^",9)=Y,X=$P(HT,"^",8),Y=$J(2.54*X,0,2),$P(HT,"^",9)=Y
- +4 SET WT=$$VITALF^APSPFUNC(DFN,"WT")
- SET $PIECE(WT,U,9)=$$VITCWT^APSPFUNC($PIECE(WT,U,8))
- +5 SET HT=$$VITALF^APSPFUNC(DFN,"HT")
- SET $PIECE(HT,U,9)=$$VITCHT^APSPFUNC($PIECE(HT,U,8))
- +6 IF $GET(POERR)
- QUIT
- +7 WRITE !!,"WEIGHT(Kg): "
- IF +$PIECE(WT,"^",8)
- WRITE $PIECE(WT,"^",9)_" ("_$PIECE(WT,"^")_")"
- WRITE ?41,"HEIGHT(cm): "
- IF $PIECE(HT,"^",8)
- WRITE $PIECE(HT,"^",9)_" ("_$PIECE(HT,"^")_")"
- KILL VM,WT,HT
- +8 SET PSLC=0
- IF $PIECE($GET(^DPT(DFN,.17)),"^",2)'="I"
- GOTO MA
- +9 IF '$DATA(VAEL(1))
- DO ELIG^VADPT
- WRITE !!,"ELIGIBILITY: ",$PIECE(VAEL(1),"^",2)
- IF +VAEL(3)
- WRITE ?$X+5,"SC%: "_$PIECE(VAEL(3),"^",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(^DPT(DFN,.372,I,0)):^(0),1:"")
- IF +I1
- Begin DoDot:1
- +2 SET PSDIS=$SELECT($PIECE($GET(^DIC(31,+I1,0)),"^")]""&($PIECE($GET(^(0)),"^",4)']""):$PIECE(^(0),"^"),$PIECE($GET(^DIC(31,+I1,0)),"^",4)]"":$PIECE(^(0),"^",4),1:"")
- SET PSCNT=$PIECE(I1,"^",2)
- +3 IF ($X+$LENGTH(PSDIS)+7)>(IOM-8)
- XECUTE "W !?14 S PSLC=PSLC+1"
- WRITE PSDIS,"-",PSCNT,"% (",$SELECT($PIECE(I1,"^",3):"SC",1:"NSC"),"), "
- +4 IF $EXTRACT(IOST)="C"
- IF $Y+4>IOSL
- IF $DATA(PSTYPE)
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- KILL DIR,DTOUT
- WRITE @IOF,?13
- End DoDot:1
- +5 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
- IF $GET(PSTYPE)']""
- DO KVA^VADPT
- QUIT
- GMRA KILL ^TMP($JOB,"AL")
- SET GMRA="0^0^111"
- DO ^GMRADPT
- IF GMRAL
- Begin DoDot:1
- +1 FOR DR=0:0
- SET DR=$ORDER(GMRAL(DR))
- IF 'DR
- QUIT
- SET ^TMP($JOB,"AL",$SELECT('$PIECE(GMRAL(DR),"^",5):1,1:2),$PIECE(GMRAL(DR),"^",7),$PIECE(GMRAL(DR),"^",2))=""
- +2 WRITE !!,"ALLERGIES: "
- SET (DR,TY)=""
- FOR I=0:0
- SET TY=$ORDER(^TMP($JOB,"AL",1,TY))
- IF TY=""
- QUIT
- FOR D=0:0
- SET DR=$ORDER(^TMP($JOB,"AL",1,TY,DR))
- IF DR=""
- QUIT
- IF $X+$LENGTH(DR)+$LENGTH(", ")>IOM
- WRITE !?11
- WRITE DR_", "
- Begin DoDot:2
- +3 IF $EXTRACT(IOST)="C"
- IF $Y+4>IOSL
- IF $DATA(PSTYPE)
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- KILL DIR,DTOUT
- WRITE @IOF,?18
- End DoDot:2
- +4 WRITE !!,"ADVERSE REACTIONS: "
- SET (DR,TY)=""
- FOR I=0:0
- SET TY=$ORDER(^TMP($JOB,"AL",2,TY))
- IF TY=""
- QUIT
- FOR D=0:0
- SET DR=$ORDER(^TMP($JOB,"AL",2,TY,DR))
- IF DR=""
- QUIT
- IF $X+$LENGTH(DR)+$LENGTH(", ")>IOM
- WRITE !?19
- WRITE DR_", "
- Begin DoDot:2
- +5 IF $EXTRACT(IOST)="C"
- IF $Y+4>IOSL
- IF $DATA(PSTYPE)
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- KILL DIR,DTOUT
- WRITE @IOF,?18
- End DoDot:2
- End DoDot:1
- +6 IF $GET(GMRAL)']""
- FOR AD="ALLERGIES:","ADVERSE REACTIONS:"
- WRITE !!,AD
- IF $GET(PSOFROM)=""
- FOR ADL=1:1:IOM-($LENGTH(AD)+5)
- WRITE "_"
- +7 IF GMRAL=0
- WRITE !!,"ALLERGIES: NKA",!!,"ADVERSE REACTIONS:"
- +8 WRITE !
- KILL TY,D,I,GMRA,GMRAL,DR,AD,ADL,^TMP($JOB,"AL")
- QUIT