- PSOORUT2 ;ISC BHAM/SAB - build listman screen ;06-Aug-2012 08:32;PLS
- ;;7.0;OUTPATIENT PHARMACY;**11,146,132,1005,1006,182,233,243,261,268,264,305,1015**;DEC 1997;Build 62
- ;External reference to SDPHARM1 supported by DBIA 4196
- ;External reference ^PS(55 supported by DBIA 2228
- ;External reference ^DIC(31 supported by DBIA 658
- ;External reference ^DPT(D0,.372 supported by DBIA 1476
- ;External references to ^ORRDI1 supported by DBIA 4659
- ;External references to ^XTMP("ORRDI" supported by DBIA 4660
- ; Modified - IHS/CIA/PLS - 03/10/04
- ; IHS/MSC/PLS - 08/30/06 - Adjusted Medicare output to include Plan Name
- ; 03/21/07 - Line PSOORUT2+55 - Check for SD v5.3 patch 318
- ; 10/11/07 - Line NVA+6
- ;
- K ^TMP("PSOHDR",$J),^TMP("PSOPI",$J) S DFN=PSODFN D ^VADPT,ADD^VADPT
- S ^TMP("PSOHDR",$J,1,0)=VADM(1),^TMP("PSOHDR",$J,2,0)=$P(VADM(2),"^",2)
- S ^TMP("PSOHDR",$J,3,0)=$P(VADM(3),"^",2),^TMP("PSOHDR",$J,4,0)=VADM(4),^TMP("PSOHDR",$J,5,0)=$P(VADM(5),"^",2)
- D NVA
- S POERR=1 D RE^PSODEM K POERR
- S ^TMP("PSOHDR",$J,6,0)=$S($P(WT,"^",8):$P(WT,"^",9)_" ("_$P(WT,"^")_")",1:"_______ (______)")
- S ^TMP("PSOHDR",$J,7,0)=$S($P(HT,"^",8):$P(HT,"^",9)_" ("_$P(HT,"^")_")",1:"_______ (______)") K VM,WT,HT S PSOHD=7
- S GMRA="0^0^111" D ^GMRADPT S ^TMP("PSOHDR",$J,8,0)=+$G(GMRAL)
- S $P(^TMP("PSOHDR",$J,9,0)," ",62)="ISSUE LAST REF DAY"
- S ^TMP("PSOHDR",$J,10,0)=" # RX # DRUG QTY ST DATE "_$S($G(PSORFG):"RELD",1:"FILL")_" REM SUP"
- ; IHS/CIA/PLS - 03/10/04 - Changed to IHS Eligibility
- S IEN=1
- ;D ELIG^VADPT,^TMP("PSOPI",$J,IEN,0)="Eligibility: "_$P(VAEL(1),"^",2)_$S(+VAEL(3):" SC%: "_$P(VAEL(3),"^",2),1:""),IEN=IEN+1
- ;S N=0 F S N=$O(VAEL(1,N)) Q:'N S $P(^TMP("PSOPI",$J,IEN,0)," ",14)=$P(VAEL(1,N),"^",2),IEN=IEN+1
- S ^TMP("PSOPI",$J,IEN,0)="",^TMP("PSOPI",$J,IEN,0)="RX PATIENT STATUS: "_$$GET1^DIQ(55,PSODFN,3),IEN=IEN+1
- ;S ^TMP("PSOPI",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Disabilities: "
- S ^TMP("PSOPI",$J,IEN,0)="Eligibility: "_$$GET1^DIQ(9000001,DFN,1112),IEN=IEN+1
- ; IHS/CIA/PLS - 03/11/04 - Added insurer information
- ;S ^TMP("PSOPI",$J,2,0)=" ",IEN=3,^TMP("PSOPI",$J,IEN,0)="Disabilities: "
- ;S ^TMP("PSOPI",$J,2,0)=" "
- S ^TMP("PSOPI",$J,IEN,0)="Insurance Information: ",IEN=IEN+1
- I $$MCD^APSQPINS(DFN,DT) D S IEN=IEN+1
- .S ^TMP("PSOPI",$J,IEN,0)=" MEDICAID - "_$S($$MCD^APSQPINS(DFN,DT):"Grace Period: "_$$GP^APSQPINS($$MCD^APSQPINS(DFN,DT)),1:"No Data")
- S MCR=$$MCR^APSQPINS(DFN,DT)
- I MCR D S IEN=IEN+1
- .S ^TMP("PSOPI",$J,IEN,0)=" MEDICARE - "_$$GET1^DIQ(9999999.18,+$P(MCR,U,2),.01)_" - "_$S(MCR:"Grace Period: "_$$GP^APSQPINS(+MCR),1:"No Data")
- S TMPINS=$$PIN^APSQPINS(DFN,DT,"E")
- I $L(TMPINS) D
- .S ^TMP("PSOPI",$J,IEN,0)=" PRIVATE - "_$S($L($P(TMPINS,",")):$$PINS($P(TMPINS,",")),1:"No Data")
- .S IEN=IEN+1
- .F PILP=2:1:$L(TMPINS,",") I $L($P(TMPINS,",",PILP)) D
- ..S ^TMP("PSOPI",$J,IEN,0)=" "_$$PINS($P(TMPINS,",",PILP))
- ..S IEN=IEN+1
- S ^TMP("PSOPI",$J,IEN,0)=" ",IEN=IEN+1
- S ^TMP("PSOPI",$J,IEN,0)="Disabilities: "
- 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)
- .S:$L(^TMP("PSOPI",$J,IEN,0)_PSDIS_"-"_PSCNT_"% ("_$S($P(I1,"^",3):"SC",1:"NSC")_"), ")>80 IEN=IEN+1,$P(^TMP("PSOPI",$J,IEN,0)," ",14)=" "
- .S ^TMP("PSOPI",$J,IEN,0)=$G(^TMP("PSOPI",$J,IEN,0))_PSDIS_"-"_PSCNT_"% ("_$S($P(I1,"^",3):"SC",1:"NSC")_"), "
- S IEN=IEN+1 S ^TMP("PSOPI",$J,IEN,0)=" ",IEN=IEN+1
- I +VAPA(9) S ^TMP("PSOPI",$J,IEN,0)=" (Temp Address from "_$P(VAPA(9),"^",2)_" till "_$S($P(VAPA(10),"^",2)]"":$P(VAPA(10),"^",2),1:"(no end date)")_")",IEN=IEN+1
- S ^TMP("PSOPI",$J,IEN,0)=VAPA(1) S:VAPA(2)]"" IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=VAPA(2) S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=VAPA(3)
- S ^TMP("PSOPI",$J,IEN,0)=^TMP("PSOPI",$J,IEN,0)_$J("",50-$L(VAPA(3)))_"HOME PHONE: "_VAPA(8)
- S PSOTEL=$G(^DPT(DFN,.13))
- S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=VAPA(4),^TMP("PSOPI",$J,IEN,0)=^TMP("PSOPI",$J,IEN,0)_$J("",50-$L(VAPA(4)))_"CELL PHONE: "_$P(PSOTEL,"^",4)
- S PSOTMP=$P(VAPA(5),"^",2)_" "_$S(VAPA(11)]"":$P(VAPA(11),"^",2),1:VAPA(6)),IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=PSOTMP
- S ^TMP("PSOPI",$J,IEN,0)=^TMP("PSOPI",$J,IEN,0)_$J("",50-$L(PSOTMP))_"WORK PHONE: "_$P(PSOTEL,"^",2)
- S MAILD=+$P($G(^PS(55,DFN,0)),"^",3) D K MAILD
- .S PSOTMP="Prescription Mail Delivery: "_$S(MAILD=1:"Certified Mail",MAILD=2:"DO NOT MAIL",MAILD=3:"Local - Regular Mail",MAILD=4:"Local - Certified Mail",1:"Regular Mail") S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=PSOTMP
- .I MAILD<2!(MAILD>4) Q ;ONLY FOR MAIL DELIVERIES 2,3,4
- .N PSOMDEXP,Y
- .S Y=$P($G(^PS(55,DFN,0)),"^",5)
- .I Y,Y'>DT D
- ..D DD^%DT S PSOMDEXP=Y
- ..S ^TMP("PSOPI",$J,IEN,0)=^TMP("PSOPI",$J,IEN,0)_" Expire Date: "_PSOMDEXP
- S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=$S($P($G(^PS(55,DFN,0)),"^",2):"Cannot use safety caps.",1:"") S $P(^TMP("PSOPI",$J,IEN,0)," ",40)=$S($P($G(^PS(55,DFN,0)),"^",4):"Dialysis Patient.",1:"")
- I $G(^PS(55,DFN,1))]"" S PSON=^(1),IEN=IEN+1 D
- .S ^TMP("PSOPI",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" Outpatient Narrative: "
- .F I=1:1 Q:$P(PSON," ",I,99)="" S:$L(^TMP("PSOPI",$J,IEN,0)_$P(PSON," ",I)_" ")>80 IEN=IEN+1 S ^TMP("PSOPI",$J,IEN,0)=$G(^TMP("PSOPI",$J,IEN,0))_$P(PSON," ",I)_" "
- S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" "
- I $D(^PS(52.91,DFN,0)) I '$P(^(0),"^",3)!($P(^(0),"^",3)>DT) D
- .Q:'$$PATCH^XPDUTL("SD*5.3*318") ;IHS/MSC/PLS - 03/21/2007 - Added check for SD patch
- .S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Primary Care Appointment: "_$$PRIAPT^SDPHARM1(DFN)
- .S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" "
- I 'GMRAL D
- .S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Allergies: "_$S(GMRAL=0:"NKA",1:"")
- .I GMRAL'=0 S PSONOAL="" D ALLERGY I PSONOAL'="" S ^TMP("PSOPI",$J,IEN,0)="Allergies: "_PSONOAL K PSONOAL
- .S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" "
- .D REMOTE
- .S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Adverse Reactions:"
- D:$G(GMRAL) ^PSOORUT3
- K ^UTILITY("VASD",$J),VASD S DFN=PSODFN,VASD("F")=DT,VASD("T")=9999999,VASD("W")="123456789" D SDA^VADPT K VASD I $D(^UTILITY("VASD",$J)) D
- .S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Pending Clinic Appointments:"
- .F PSOAPP=0:0 S PSOAPP=$O(^UTILITY("VASD",$J,PSOAPP)) Q:'PSOAPP S PSOAPPE=$G(^UTILITY("VASD",$J,PSOAPP,"E")),PSOAPPI=$G(^("I")) D
- ..K X S X2=DT,X1=$P($P($G(PSOAPPI),"^"),".") I $G(X1) D ^%DTC
- ..S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" "_$P(PSOAPPE,"^")_" "_$P(PSOAPPE,"^",2)_$S($P(PSOAPPI,"^",3)["C":" *** Canceled ***",1:" ("_$G(X)_" days)")
- K ^UTILITY("VASD",$J),X,PSOAPPI,PSOAPPE,PSOAPP,N
- S PSOPI=IEN K IEN
- Q
- ; Return formatted private insurance
- PINS(VAL) ;
- Q:'$L($G(VAL)) ""
- N I,G
- S I=$P(VAL,"*")
- S G=$P(VAL,"*",2)
- Q I_" - Grace Period: "_G
- NVA ;
- Q:'$O(^PS(55,PSODFN,"NVA",0))
- K LSTDT F I=0:0 S I=$O(^PS(55,PSODFN,"NVA",I)) Q:'I D
- .Q:$P(^PS(55,PSODFN,"NVA",I,0),"^",7) Q:'$P(^PS(55,PSODFN,"NVA",I,0),"^")
- .I $P(^PS(55,PSODFN,"NVA",I,0),"^",10)>+$G(LSTDT) S LSTDT=$P(^(0),"^",10)
- I $G(LSTDT)]"" D
- .;IHS/MSC/PLS - 10/11/07 - Changed references of Non-VA to Outside Medications
- .;S LSTDT="Non-VA Meds on File - Last entry on "_$E(LSTDT,4,5)_"/"_$E(LSTDT,6,7)_"/"_$E(LSTDT,2,3)
- .S LSTDT="Outside Medications on File - Last entry on "_$E(LSTDT,4,5)_"/"_$E(LSTDT,6,7)_"/"_$E(LSTDT,2,3)
- .I $G(^TMP("PSOHDR",$J,5,0))="MALE" S $P(^TMP("PSOHDR",$J,5,0)," ",22)=LSTDT K LSTDT Q
- .S $P(^TMP("PSOHDR",$J,5,0)," ",20)=LSTDT K LSTDT
- K I
- Q
- REMOTE ;
- I $T(HAVEHDR^ORRDI1)']"" Q
- I '$$HAVEHDR^ORRDI1 Q
- N PSORALG,REAC,S1,A,FILE,LEN,I
- K ^TMP($J,"PSOART")
- S PSORALG=1,PSORALG(1)="No remote data available"
- I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) G REMOTE2
- I $T(GET^ORRDI1)]"" S PSOSIEN=$G(IEN) D GET^ORRDI1(DFN,"ART") S IEN=PSOSIEN K PSOSIEN D
- .I $P($G(^XTMP("ORRDI","ART",DFN,0)),"^",3)=0 S PSORALG(1)="No remote allergies"
- .S S1=0,LEN=65,PSORALG=1,PSORALG(1)="" F S S1=$O(^XTMP("ORRDI","ART",DFN,S1)) Q:'S1 D
- ..S A=$G(^XTMP("ORRDI","ART",DFN,S1,"REACTANT",0)),REAC=$P(A,"^",2),FILE=$P($P(A,"^",3),"99VA",2)
- ..I FILE'=50.6,FILE'=120.82,FILE'=50.605,FILE'=50.416 Q
- ..S ^TMP($J,"PSOART",REAC)=""
- .S REAC="" F S REAC=$O(^TMP($J,"PSOART",REAC)) Q:REAC="" D
- ..I $L(PSORALG(PSORALG))+$L(REAC)<LEN S PSORALG(PSORALG)=PSORALG(PSORALG)_REAC_", " Q
- ..S PSORALG=PSORALG+1,PSORALG(PSORALG)=" "_REAC_", ",LEN=76
- .I PSORALG(PSORALG)]"",$E(PSORALG(PSORALG),$L(PSORALG(PSORALG)))="," S PSORALG(PSORALG)=$E(PSORALG(PSORALG),1,$L(PSORALG(PSORALG))-1)
- REMOTE2 ;
- S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=" Remote: "_$G(PSORALG(1)) D
- .F I=2:1:PSORALG S IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)=PSORALG(I)
- K ^TMP($J,"PSOART")
- Q
- ;
- ALLERGY ;ALLERGIES & REACTIONS
- N GMRA,GMRAL,PSORY,ALCNT,EEE,PSOLG,PSOLGA,TEXT,CCC,CCC2
- K ^TMP($J,"PSOALWA")
- I '$D(DFN) S DFN=PSODFN
- S GMRA="0^0^111" D ^GMRADPT
- I $G(GMRAL) S PSORY=0 F S PSORY=$O(GMRAL(PSORY)) Q:'PSORY S ^TMP($J,"PSOALWA",$S($P(GMRAL(PSORY),"^",4):1,1:2),$S('$P(GMRAL(PSORY),"^",5):1,1:2),$P(GMRAL(PSORY),"^",7),$P(GMRAL(PSORY),"^",2))=""
- S ^TMP($J,"PSOAPT",1)=$G(PNM)_" "_$G(SSNP),^(2)="Verified Allergies"
- S ALCNT=0,EEE=0,(PSOLG,PSOLGA)="" F S PSOLG=$O(^TMP($J,"PSOALWA",1,1,PSOLG)) Q:PSOLG="" F S PSOLGA=$O(^TMP($J,"PSOALWA",1,1,PSOLG,PSOLGA)) Q:PSOLGA="" S EEE=1,ALCNT=ALCNT+1,^TMP($J,"PSOAPT",2,ALCNT)=PSOLGA
- I 'EEE,$G(GMRAL)=0 S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",2,ALCNT)="NKA"
- S ALCNT=0,^TMP($J,"PSOAPT",3)="Non-Verified Allergies"
- S EEE=0,(PSOLG,PSOLGA)="" F S PSOLG=$O(^TMP($J,"PSOALWA",2,1,PSOLG)) Q:PSOLG="" F S PSOLGA=$O(^TMP($J,"PSOALWA",2,1,PSOLG,PSOLGA)) Q:PSOLGA="" S EEE=EEE+1,ALCNT=ALCNT+1,^TMP($J,"PSOAPT",3,ALCNT)=PSOLGA
- I 'EEE,$G(GMRAL)=0 S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",3,ALCNT)="NKA"
- S ALCNT=0,^TMP($J,"PSOAPT",4)="Verified Adverse Reactions"
- S (PSOLG,PSOLGA)="" F S PSOLG=$O(^TMP($J,"PSOALWA",1,2,PSOLG)) Q:PSOLG="" F S PSOLGA=$O(^TMP($J,"PSOALWA",1,2,PSOLG,PSOLGA)) Q:PSOLGA="" S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",4,ALCNT)=PSOLGA
- S ALCNT=0,^TMP($J,"PSOAPT",5)="Non-Verified Adverse Reactions"
- S (PSOLG,PSOLGA)="" F S PSOLG=$O(^TMP($J,"PSOALWA",2,2,PSOLG)) Q:PSOLG="" F S PSOLGA=$O(^TMP($J,"PSOALWA",2,2,PSOLG,PSOLGA)) Q:PSOLGA="" S ALCNT=ALCNT+1,^TMP($J,"PSOAPT",5,ALCNT)=PSOLGA
- S TEXT=^TMP($J,"PSOAPT",1) D CHKNO(TEXT)
- F CCC=3,4,5 I '$O(^TMP($J,"PSOAPT",CCC,0)) K ^TMP($J,"PSOAPT",CCC)
- D PSONOAL
- I CCC="NKA" S ^TMP($J,"PSOAPT",2,1)="No Known Allergies" K ^TMP($J,"PSOAPT",3)
- S CCC=1,OUT=0
- F S CCC=$O(^TMP($J,"PSOAPT",CCC)) Q:CCC="" D Q:OUT
- .S TEXT=$G(^TMP($J,"PSOAPT",CCC))
- .I TEXT="No Allergy Assessment" S PSONOAL=TEXT Q
- .S (TEXT,CCC2)="",LENGTH=0
- .F S CCC2=$O(^TMP($J,"PSOAPT",CCC,CCC2)) Q:CCC2="" S TEXT=^(CCC2) D CHKNO(TEXT)
- K ^TMP($J,"PSOALWA"),^TMP($J,"PSOAPT")
- Q
- CHKNO(T) ;
- I T="No Allergy Assessment" S PSONOAL=T
- Q
- PSONOAL ;
- N FLG3,FLG4,FLG5
- S CCC=$G(^TMP($J,"PSOAPT",2,1))
- S FLG3=$G(^TMP($J,"PSOAPT",3,1))
- S FLG4=$G(^TMP($J,"PSOAPT",4,1))
- S FLG5=$G(^TMP($J,"PSOAPT",5,1))
- I CCC="",FLG3="",FLG4="",FLG5="" S ^TMP($J,"PSOAPT",2,1)="No Allergy Assessment" K ^TMP($J,"PSOAPT",3)
- Q
- PSOORUT2 ;ISC BHAM/SAB - build listman screen ;06-Aug-2012 08:32;PLS
- +1 ;;7.0;OUTPATIENT PHARMACY;**11,146,132,1005,1006,182,233,243,261,268,264,305,1015**;DEC 1997;Build 62
- +2 ;External reference to SDPHARM1 supported by DBIA 4196
- +3 ;External reference ^PS(55 supported by DBIA 2228
- +4 ;External reference ^DIC(31 supported by DBIA 658
- +5 ;External reference ^DPT(D0,.372 supported by DBIA 1476
- +6 ;External references to ^ORRDI1 supported by DBIA 4659
- +7 ;External references to ^XTMP("ORRDI" supported by DBIA 4660
- +8 ; Modified - IHS/CIA/PLS - 03/10/04
- +9 ; IHS/MSC/PLS - 08/30/06 - Adjusted Medicare output to include Plan Name
- +10 ; 03/21/07 - Line PSOORUT2+55 - Check for SD v5.3 patch 318
- +11 ; 10/11/07 - Line NVA+6
- +12 ;
- +13 KILL ^TMP("PSOHDR",$JOB),^TMP("PSOPI",$JOB)
- SET DFN=PSODFN
- DO ^VADPT
- DO ADD^VADPT
- +14 SET ^TMP("PSOHDR",$JOB,1,0)=VADM(1)
- SET ^TMP("PSOHDR",$JOB,2,0)=$PIECE(VADM(2),"^",2)
- +15 SET ^TMP("PSOHDR",$JOB,3,0)=$PIECE(VADM(3),"^",2)
- SET ^TMP("PSOHDR",$JOB,4,0)=VADM(4)
- SET ^TMP("PSOHDR",$JOB,5,0)=$PIECE(VADM(5),"^",2)
- +16 DO NVA
- +17 SET POERR=1
- DO RE^PSODEM
- KILL POERR
- +18 SET ^TMP("PSOHDR",$JOB,6,0)=$SELECT($PIECE(WT,"^",8):$PIECE(WT,"^",9)_" ("_$PIECE(WT,"^")_")",1:"_______ (______)")
- +19 SET ^TMP("PSOHDR",$JOB,7,0)=$SELECT($PIECE(HT,"^",8):$PIECE(HT,"^",9)_" ("_$PIECE(HT,"^")_")",1:"_______ (______)")
- KILL VM,WT,HT
- SET PSOHD=7
- +20 SET GMRA="0^0^111"
- DO ^GMRADPT
- SET ^TMP("PSOHDR",$JOB,8,0)=+$GET(GMRAL)
- +21 SET $PIECE(^TMP("PSOHDR",$JOB,9,0)," ",62)="ISSUE LAST REF DAY"
- +22 SET ^TMP("PSOHDR",$JOB,10,0)=" # RX # DRUG QTY ST DATE "_$SELECT($GET(PSORFG):"RELD",1:"FILL")_" REM SUP"
- +23 ; IHS/CIA/PLS - 03/10/04 - Changed to IHS Eligibility
- +24 SET IEN=1
- +25 ;D ELIG^VADPT,^TMP("PSOPI",$J,IEN,0)="Eligibility: "_$P(VAEL(1),"^",2)_$S(+VAEL(3):" SC%: "_$P(VAEL(3),"^",2),1:""),IEN=IEN+1
- +26 ;S N=0 F S N=$O(VAEL(1,N)) Q:'N S $P(^TMP("PSOPI",$J,IEN,0)," ",14)=$P(VAEL(1,N),"^",2),IEN=IEN+1
- +27 SET ^TMP("PSOPI",$JOB,IEN,0)=""
- SET ^TMP("PSOPI",$JOB,IEN,0)="RX PATIENT STATUS: "_$$GET1^DIQ(55,PSODFN,3)
- SET IEN=IEN+1
- +28 ;S ^TMP("PSOPI",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOPI",$J,IEN,0)="Disabilities: "
- +29 SET ^TMP("PSOPI",$JOB,IEN,0)="Eligibility: "_$$GET1^DIQ(9000001,DFN,1112)
- SET IEN=IEN+1
- +30 ; IHS/CIA/PLS - 03/11/04 - Added insurer information
- +31 ;S ^TMP("PSOPI",$J,2,0)=" ",IEN=3,^TMP("PSOPI",$J,IEN,0)="Disabilities: "
- +32 ;S ^TMP("PSOPI",$J,2,0)=" "
- +33 SET ^TMP("PSOPI",$JOB,IEN,0)="Insurance Information: "
- SET IEN=IEN+1
- +34 IF $$MCD^APSQPINS(DFN,DT)
- Begin DoDot:1
- +35 SET ^TMP("PSOPI",$JOB,IEN,0)=" MEDICAID - "_$SELECT($$MCD^APSQPINS(DFN,DT):"Grace Period: "_$$GP^APSQPINS($$MCD^APSQPINS(DFN,DT)),1:"No Data")
- End DoDot:1
- SET IEN=IEN+1
- +36 SET MCR=$$MCR^APSQPINS(DFN,DT)
- +37 IF MCR
- Begin DoDot:1
- +38 SET ^TMP("PSOPI",$JOB,IEN,0)=" MEDICARE - "_$$GET1^DIQ(9999999.18,+$PIECE(MCR,U,2),.01)_" - "_$SELECT(MCR:"Grace Period: "_$$GP^APSQPINS(+MCR),1:"No Data")
- End DoDot:1
- SET IEN=IEN+1
- +39 SET TMPINS=$$PIN^APSQPINS(DFN,DT,"E")
- +40 IF $LENGTH(TMPINS)
- Begin DoDot:1
- +41 SET ^TMP("PSOPI",$JOB,IEN,0)=" PRIVATE - "_$SELECT($LENGTH($PIECE(TMPINS,",")):$$PINS($PIECE(TMPINS,",")),1:"No Data")
- +42 SET IEN=IEN+1
- +43 FOR PILP=2:1:$LENGTH(TMPINS,",")
- IF $LENGTH($PIECE(TMPINS,",",PILP))
- Begin DoDot:2
- +44 SET ^TMP("PSOPI",$JOB,IEN,0)=" "_$$PINS($PIECE(TMPINS,",",PILP))
- +45 SET IEN=IEN+1
- End DoDot:2
- End DoDot:1
- +46 SET ^TMP("PSOPI",$JOB,IEN,0)=" "
- SET IEN=IEN+1
- +47 SET ^TMP("PSOPI",$JOB,IEN,0)="Disabilities: "
- +48 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
- +49 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)
- +50 IF $LENGTH(^TMP("PSOPI",$JOB,IEN,0)_PSDIS_"-"_PSCNT_"% ("_$SELECT($PIECE(I1,"^",3)
- SET IEN=IEN+1
- SET $PIECE(^TMP("PSOPI",$JOB,IEN,0)," ",14)=" "
- +51 SET ^TMP("PSOPI",$JOB,IEN,0)=$GET(^TMP("PSOPI",$JOB,IEN,0))_PSDIS_"-"_PSCNT_"% ("_$SELECT($PIECE(I1,"^",3):"SC",1:"NSC")_"), "
- End DoDot:1
- +52 SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)=" "
- SET IEN=IEN+1
- +53 IF +VAPA(9)
- SET ^TMP("PSOPI",$JOB,IEN,0)=" (Temp Address from "_$PIECE(VAPA(9),"^",2)_" till "_$SELECT($PIECE(VAPA(10),"^",2)]"":$PIECE(VAPA(10),"^",2),1:"(no end date)")_")"
- SET IEN=IEN+1
- +54 SET ^TMP("PSOPI",$JOB,IEN,0)=VAPA(1)
- IF VAPA(2)]""
- SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)=VAPA(2)
- SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)=VAPA(3)
- +55 SET ^TMP("PSOPI",$JOB,IEN,0)=^TMP("PSOPI",$JOB,IEN,0)_$JUSTIFY("",50-$LENGTH(VAPA(3)))_"HOME PHONE: "_VAPA(8)
- +56 SET PSOTEL=$GET(^DPT(DFN,.13))
- +57 SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)=VAPA(4)
- SET ^TMP("PSOPI",$JOB,IEN,0)=^TMP("PSOPI",$JOB,IEN,0)_$JUSTIFY("",50-$LENGTH(VAPA(4)))_"CELL PHONE: "_$PIECE(PSOTEL,"^",4)
- +58 SET PSOTMP=$PIECE(VAPA(5),"^",2)_" "_$SELECT(VAPA(11)]"":$PIECE(VAPA(11),"^",2),1:VAPA(6))
- SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)=PSOTMP
- +59 SET ^TMP("PSOPI",$JOB,IEN,0)=^TMP("PSOPI",$JOB,IEN,0)_$JUSTIFY("",50-$LENGTH(PSOTMP))_"WORK PHONE: "_$PIECE(PSOTEL,"^",2)
- +60 SET MAILD=+$PIECE($GET(^PS(55,DFN,0)),"^",3)
- Begin DoDot:1
- +61 SET PSOTMP="Prescription Mail Delivery: "_$SELECT(MAILD=1:"Certified Mail",MAILD=2:"DO NOT MAIL",MAILD=3:"Local - Regular Mail",MAILD=4:"Local - Certified Mail",1:"Regular Mail")
- SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)=PSOTMP
- +62 ;ONLY FOR MAIL DELIVERIES 2,3,4
- IF MAILD<2!(MAILD>4)
- QUIT
- +63 NEW PSOMDEXP,Y
- +64 SET Y=$PIECE($GET(^PS(55,DFN,0)),"^",5)
- +65 IF Y
- IF Y'>DT
- Begin DoDot:2
- +66 DO DD^%DT
- SET PSOMDEXP=Y
- +67 SET ^TMP("PSOPI",$JOB,IEN,0)=^TMP("PSOPI",$JOB,IEN,0)_" Expire Date: "_PSOMDEXP
- End DoDot:2
- End DoDot:1
- KILL MAILD
- +68 SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)=$SELECT($PIECE($GET(^PS(55,DFN,0)),"^",2):"Cannot use safety caps.",1:"")
- SET $PIECE(^TMP("PSOPI",$JOB,IEN,0)," ",40)=$SELECT($PIECE($GET(^PS(55,DFN,0)),"^",4):"Dialysis Patient.",1:"")
- +69 IF $GET(^PS(55,DFN,1))]""
- SET PSON=^(1)
- SET IEN=IEN+1
- Begin DoDot:1
- +70 SET ^TMP("PSOPI",$JOB,IEN,0)=" "
- SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)=" Outpatient Narrative: "
- +71 FOR I=1:1
- IF $PIECE(PSON," ",I,99)=""
- QUIT
- IF $LENGTH(^TMP("PSOPI",$JOB,IEN,0)_$PIECE(PSON," ",I)_" ")>80
- SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)=$GET(^TMP("PSOPI",$JOB,IEN,0))_$PIECE(PSON," ",I)_" "
- End DoDot:1
- +72 SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)=" "
- +73 IF $DATA(^PS(52.91,DFN,0))
- IF '$PIECE(^(0),"^",3)!($PIECE(^(0),"^",3)>DT)
- Begin DoDot:1
- +74 ;IHS/MSC/PLS - 03/21/2007 - Added check for SD patch
- IF '$$PATCH^XPDUTL("SD*5.3*318")
- QUIT
- +75 SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)="Primary Care Appointment: "_$$PRIAPT^SDPHARM1(DFN)
- +76 SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)=" "
- End DoDot:1
- +77 IF 'GMRAL
- Begin DoDot:1
- +78 SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)="Allergies: "_$SELECT(GMRAL=0:"NKA",1:"")
- +79 IF GMRAL'=0
- SET PSONOAL=""
- DO ALLERGY
- IF PSONOAL'=""
- SET ^TMP("PSOPI",$JOB,IEN,0)="Allergies: "_PSONOAL
- KILL PSONOAL
- +80 SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)=" "
- +81 DO REMOTE
- +82 SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)="Adverse Reactions:"
- End DoDot:1
- +83 IF $GET(GMRAL)
- DO ^PSOORUT3
- +84 KILL ^UTILITY("VASD",$JOB),VASD
- SET DFN=PSODFN
- SET VASD("F")=DT
- SET VASD("T")=9999999
- SET VASD("W")="123456789"
- DO SDA^VADPT
- KILL VASD
- IF $DATA(^UTILITY("VASD",$JOB))
- Begin DoDot:1
- +85 SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)=" "
- SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)="Pending Clinic Appointments:"
- +86 FOR PSOAPP=0:0
- SET PSOAPP=$ORDER(^UTILITY("VASD",$JOB,PSOAPP))
- IF 'PSOAPP
- QUIT
- SET PSOAPPE=$GET(^UTILITY("VASD",$JOB,PSOAPP,"E"))
- SET PSOAPPI=$GET(^("I"))
- Begin DoDot:2
- +87 KILL X
- SET X2=DT
- SET X1=$PIECE($PIECE($GET(PSOAPPI),"^"),".")
- IF $GET(X1)
- DO ^%DTC
- +88 SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)=" "_$PIECE(PSOAPPE,"^")_" "_$PIECE(PSOAPPE,"^",2)_$SELECT($PIECE(PSOAPPI,"^",3)["C":" *** Canceled ***",1:" ("_$GET(X)_" days)")
- End DoDot:2
- End DoDot:1
- +89 KILL ^UTILITY("VASD",$JOB),X,PSOAPPI,PSOAPPE,PSOAPP,N
- +90 SET PSOPI=IEN
- KILL IEN
- +91 QUIT
- +92 ; Return formatted private insurance
- PINS(VAL) ;
- +1 IF '$LENGTH($GET(VAL))
- QUIT ""
- +2 NEW I,G
- +3 SET I=$PIECE(VAL,"*")
- +4 SET G=$PIECE(VAL,"*",2)
- +5 QUIT I_" - Grace Period: "_G
- NVA ;
- +1 IF '$ORDER(^PS(55,PSODFN,"NVA",0))
- QUIT
- +2 KILL LSTDT
- FOR I=0:0
- SET I=$ORDER(^PS(55,PSODFN,"NVA",I))
- IF 'I
- QUIT
- Begin DoDot:1
- +3 IF $PIECE(^PS(55,PSODFN,"NVA",I,0),"^",7)
- QUIT
- IF '$PIECE(^PS(55,PSODFN,"NVA",I,0),"^")
- QUIT
- +4 IF $PIECE(^PS(55,PSODFN,"NVA",I,0),"^",10)>+$GET(LSTDT)
- SET LSTDT=$PIECE(^(0),"^",10)
- End DoDot:1
- +5 IF $GET(LSTDT)]""
- Begin DoDot:1
- +6 ;IHS/MSC/PLS - 10/11/07 - Changed references of Non-VA to Outside Medications
- +7 ;S LSTDT="Non-VA Meds on File - Last entry on "_$E(LSTDT,4,5)_"/"_$E(LSTDT,6,7)_"/"_$E(LSTDT,2,3)
- +8 SET LSTDT="Outside Medications on File - Last entry on "_$EXTRACT(LSTDT,4,5)_"/"_$EXTRACT(LSTDT,6,7)_"/"_$EXTRACT(LSTDT,2,3)
- +9 IF $GET(^TMP("PSOHDR",$JOB,5,0))="MALE"
- SET $PIECE(^TMP("PSOHDR",$JOB,5,0)," ",22)=LSTDT
- KILL LSTDT
- QUIT
- +10 SET $PIECE(^TMP("PSOHDR",$JOB,5,0)," ",20)=LSTDT
- KILL LSTDT
- End DoDot:1
- +11 KILL I
- +12 QUIT
- REMOTE ;
- +1 IF $TEXT(HAVEHDR^ORRDI1)']""
- QUIT
- +2 IF '$$HAVEHDR^ORRDI1
- QUIT
- +3 NEW PSORALG,REAC,S1,A,FILE,LEN,I
- +4 KILL ^TMP($JOB,"PSOART")
- +5 SET PSORALG=1
- SET PSORALG(1)="No remote data available"
- +6 IF $DATA(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
- GOTO REMOTE2
- +7 IF $TEXT(GET^ORRDI1)]""
- SET PSOSIEN=$GET(IEN)
- DO GET^ORRDI1(DFN,"ART")
- SET IEN=PSOSIEN
- KILL PSOSIEN
- Begin DoDot:1
- +8 IF $PIECE($GET(^XTMP("ORRDI","ART",DFN,0)),"^",3)=0
- SET PSORALG(1)="No remote allergies"
- +9 SET S1=0
- SET LEN=65
- SET PSORALG=1
- SET PSORALG(1)=""
- FOR
- SET S1=$ORDER(^XTMP("ORRDI","ART",DFN,S1))
- IF 'S1
- QUIT
- Begin DoDot:2
- +10 SET A=$GET(^XTMP("ORRDI","ART",DFN,S1,"REACTANT",0))
- SET REAC=$PIECE(A,"^",2)
- SET FILE=$PIECE($PIECE(A,"^",3),"99VA",2)
- +11 IF FILE'=50.6
- IF FILE'=120.82
- IF FILE'=50.605
- IF FILE'=50.416
- QUIT
- +12 SET ^TMP($JOB,"PSOART",REAC)=""
- End DoDot:2
- +13 SET REAC=""
- FOR
- SET REAC=$ORDER(^TMP($JOB,"PSOART",REAC))
- IF REAC=""
- QUIT
- Begin DoDot:2
- +14 IF $LENGTH(PSORALG(PSORALG))+$LENGTH(REAC)<LEN
- SET PSORALG(PSORALG)=PSORALG(PSORALG)_REAC_", "
- QUIT
- +15 SET PSORALG=PSORALG+1
- SET PSORALG(PSORALG)=" "_REAC_", "
- SET LEN=76
- End DoDot:2
- +16 IF PSORALG(PSORALG)]""
- IF $EXTRACT(PSORALG(PSORALG),$LENGTH(PSORALG(PSORALG)))=","
- SET PSORALG(PSORALG)=$EXTRACT(PSORALG(PSORALG),1,$LENGTH(PSORALG(PSORALG))-1)
- End DoDot:1
- REMOTE2 ;
- +1 SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)=" Remote: "_$GET(PSORALG(1))
- Begin DoDot:1
- +2 FOR I=2:1:PSORALG
- SET IEN=IEN+1
- SET ^TMP("PSOPI",$JOB,IEN,0)=PSORALG(I)
- End DoDot:1
- +3 KILL ^TMP($JOB,"PSOART")
- +4 QUIT
- +5 ;
- ALLERGY ;ALLERGIES & REACTIONS
- +1 NEW GMRA,GMRAL,PSORY,ALCNT,EEE,PSOLG,PSOLGA,TEXT,CCC,CCC2
- +2 KILL ^TMP($JOB,"PSOALWA")
- +3 IF '$DATA(DFN)
- SET DFN=PSODFN
- +4 SET GMRA="0^0^111"
- DO ^GMRADPT
- +5 IF $GET(GMRAL)
- SET PSORY=0
- FOR
- SET PSORY=$ORDER(GMRAL(PSORY))
- IF 'PSORY
- QUIT
- SET ^TMP($JOB,"PSOALWA",$SELECT($PIECE(GMRAL(PSORY),"^",4):1,1:2),$SELECT('$PIECE(GMRAL(PSORY),"^",5):1,1:2),$PIECE(GMRAL(PSORY),"^",7),$PIECE(GMRAL(PSORY),"^",2))=""
- +6 SET ^TMP($JOB,"PSOAPT",1)=$GET(PNM)_" "_$GET(SSNP)
- SET ^(2)="Verified Allergies"
- +7 SET ALCNT=0
- SET EEE=0
- SET (PSOLG,PSOLGA)=""
- FOR
- SET PSOLG=$ORDER(^TMP($JOB,"PSOALWA",1,1,PSOLG))
- IF PSOLG=""
- QUIT
- FOR
- SET PSOLGA=$ORDER(^TMP($JOB,"PSOALWA",1,1,PSOLG,PSOLGA))
- IF PSOLGA=""
- QUIT
- SET EEE=1
- SET ALCNT=ALCNT+1
- SET ^TMP($JOB,"PSOAPT",2,ALCNT)=PSOLGA
- +8 IF 'EEE
- IF $GET(GMRAL)=0
- SET ALCNT=ALCNT+1
- SET ^TMP($JOB,"PSOAPT",2,ALCNT)="NKA"
- +9 SET ALCNT=0
- SET ^TMP($JOB,"PSOAPT",3)="Non-Verified Allergies"
- +10 SET EEE=0
- SET (PSOLG,PSOLGA)=""
- FOR
- SET PSOLG=$ORDER(^TMP($JOB,"PSOALWA",2,1,PSOLG))
- IF PSOLG=""
- QUIT
- FOR
- SET PSOLGA=$ORDER(^TMP($JOB,"PSOALWA",2,1,PSOLG,PSOLGA))
- IF PSOLGA=""
- QUIT
- SET EEE=EEE+1
- SET ALCNT=ALCNT+1
- SET ^TMP($JOB,"PSOAPT",3,ALCNT)=PSOLGA
- +11 IF 'EEE
- IF $GET(GMRAL)=0
- SET ALCNT=ALCNT+1
- SET ^TMP($JOB,"PSOAPT",3,ALCNT)="NKA"
- +12 SET ALCNT=0
- SET ^TMP($JOB,"PSOAPT",4)="Verified Adverse Reactions"
- +13 SET (PSOLG,PSOLGA)=""
- FOR
- SET PSOLG=$ORDER(^TMP($JOB,"PSOALWA",1,2,PSOLG))
- IF PSOLG=""
- QUIT
- FOR
- SET PSOLGA=$ORDER(^TMP($JOB,"PSOALWA",1,2,PSOLG,PSOLGA))
- IF PSOLGA=""
- QUIT
- SET ALCNT=ALCNT+1
- SET ^TMP($JOB,"PSOAPT",4,ALCNT)=PSOLGA
- +14 SET ALCNT=0
- SET ^TMP($JOB,"PSOAPT",5)="Non-Verified Adverse Reactions"
- +15 SET (PSOLG,PSOLGA)=""
- FOR
- SET PSOLG=$ORDER(^TMP($JOB,"PSOALWA",2,2,PSOLG))
- IF PSOLG=""
- QUIT
- FOR
- SET PSOLGA=$ORDER(^TMP($JOB,"PSOALWA",2,2,PSOLG,PSOLGA))
- IF PSOLGA=""
- QUIT
- SET ALCNT=ALCNT+1
- SET ^TMP($JOB,"PSOAPT",5,ALCNT)=PSOLGA
- +16 SET TEXT=^TMP($JOB,"PSOAPT",1)
- DO CHKNO(TEXT)
- +17 FOR CCC=3,4,5
- IF '$ORDER(^TMP($JOB,"PSOAPT",CCC,0))
- KILL ^TMP($JOB,"PSOAPT",CCC)
- +18 DO PSONOAL
- +19 IF CCC="NKA"
- SET ^TMP($JOB,"PSOAPT",2,1)="No Known Allergies"
- KILL ^TMP($JOB,"PSOAPT",3)
- +20 SET CCC=1
- SET OUT=0
- +21 FOR
- SET CCC=$ORDER(^TMP($JOB,"PSOAPT",CCC))
- IF CCC=""
- QUIT
- Begin DoDot:1
- +22 SET TEXT=$GET(^TMP($JOB,"PSOAPT",CCC))
- +23 IF TEXT="No Allergy Assessment"
- SET PSONOAL=TEXT
- QUIT
- +24 SET (TEXT,CCC2)=""
- SET LENGTH=0
- +25 FOR
- SET CCC2=$ORDER(^TMP($JOB,"PSOAPT",CCC,CCC2))
- IF CCC2=""
- QUIT
- SET TEXT=^(CCC2)
- DO CHKNO(TEXT)
- End DoDot:1
- IF OUT
- QUIT
- +26 KILL ^TMP($JOB,"PSOALWA"),^TMP($JOB,"PSOAPT")
- +27 QUIT
- CHKNO(T) ;
- +1 IF T="No Allergy Assessment"
- SET PSONOAL=T
- +2 QUIT
- PSONOAL ;
- +1 NEW FLG3,FLG4,FLG5
- +2 SET CCC=$GET(^TMP($JOB,"PSOAPT",2,1))
- +3 SET FLG3=$GET(^TMP($JOB,"PSOAPT",3,1))
- +4 SET FLG4=$GET(^TMP($JOB,"PSOAPT",4,1))
- +5 SET FLG5=$GET(^TMP($JOB,"PSOAPT",5,1))
- +6 IF CCC=""
- IF FLG3=""
- IF FLG4=""
- IF FLG5=""
- SET ^TMP($JOB,"PSOAPT",2,1)="No Allergy Assessment"
- KILL ^TMP($JOB,"PSOAPT",3)
- +7 QUIT
