VENPCCD1 ; IHS/OIT/GIS - PATIENT DEMOG UPDATE - CONTINUATION ;
;;2.6;PCC+;;NOV 12, 2007
;
;
;
PI ; EP-PVT INSURANCE
W !,?5,IOUON,IOINHI,"Private Ins.: "
I $O(^AUPNPRVT(DFN,11,0))="" W "NONE ON FILE" Q
W IOUOFF,IOINLOW
S VEN("PI")=0
F S VEN("PI")=$O(^AUPNPRVT(DFN,11,VEN("PI"))) Q:+VEN("PI")=0 D
.S VENPI=^AUPNPRVT(DFN,11,VEN("PI"),0)
.S VEN("PIN")=$P(^AUTNINS(($P(VENPI,"^",1)),0),"^",1)
.S (VEN("ST"),Y)=$P(VENPI,"^",6) I Y'="" D DD^%DT S VEN("ST")=Y
.S (VEN("EN"),Y)=$P(VENPI,"^",7) I Y'="" D DD^%DT S VEN("EN")=Y
.S VEN("HO")=$P($G(^AUPN3PPH((+$P(VENPI,"^",8)),0)),U)
.W !,?10,VEN("PIN"),!," (Policy Holder: ",VEN("HO")," ) ",VEN("ST")," to ",VEN("EN")
Q
MDCD ; EP-MEDICAID
N MDIEN,START,FIN,TOT,Y
S TOT=0
S MDIEN=$O(^AUPNMCD("B",$G(DFN),0)) I 'MDIEN Q
W !,?5,IOUON,IOINHI,"Medicaid: (last 4 times eligible)"
I '$D(^AUPNMCD("B",DFN)) W "NONE ON FILE" Q
W IOUOFF,IOINLOW
S START=9999999
F S START=$O(^AUPNMCD(MDIEN,11,START),-1) Q:'START D I TOT>3 Q
. S TOT=TOT+1
. S FIN=$P($G(^AUPNMCD(MDIEN,11,START,0)),U,2)
. W !,?10
. S Y=$E(START,1,5) X ^DD("DD") W Y
. I 'FIN W " to ???" Q
. S Y=$E(FIN,1,5) X ^DD("DD") W " to ",Y
. I TOT=1 W " (currently eligible)" Q
Q
MCR ; EP-MEDICARE
W !,?5,IOUON,IOINHI,"Medicare: "
I (VEN("AGE")>64)&('$D(^AUPNMCR(DFN))) D MCRFL Q
I '$D(^AUPNMCR(DFN)) W "NONE ON FILE" Q
W IOUOFF,IOINLOW
S VEN("MRTY")=""
S N=0
F S N=$O(^AUPNMCR(DFN,11,N)) Q:+N=0 D
.S VEN("R")=^AUPNMCR(DFN,11,N,0)
.S (VEN("S"),Y)=$P(VEN("R"),"^",1) I Y'="" D DD^%DT S VEN("S")=Y
.S (VEN("E"),Y)=$P(VEN("R"),"^",2) I Y'="" D DD^%DT S VEN("E")=Y
.S VEN("P")=$P(VEN("R"),"^",3)
.W !,?10,"START: ",VEN("S")," to ",VEN("E")," Plan: ",VEN("P")
Q
PICK ;
S N=0
K VEN("PI")
F S N=$O(^AUPNPRVT(DFN,11,N)) Q:+N=0 D
.S VEN("R")=^AUPNPRVT(DFN,11,N,0)
.S VEN("END")=$P(VEN("R"),"^",7)
.S VEN("ST")=$P(VEN("R"),"^",6)
.S VEN("IN")=$P(VEN("R"),"^"),VEN("IN")=$P($G(^AUTNINS(VEN("IN"),0)),"^",1)
.I (VEN("END")="")&(DT'<VEN("ST")) S VEN("PI",N)=VEN("IN") Q
.I (DT'<VEN("ST"))&(DT'>VEN("END")) S VEN("PI",N)=VEN("IN") Q
Q
ELIG ; EP-edit the elig. information from pat. reg
Q:'DFN
S AGXTERN=""
K DIC
D ^AGVAR
D DFN^AGEDIT
I $$VERSION^XPDUTL("AG")["7." D VAR^AGED4A G KILL
D ^AGED4,^AGED5,^AGED6,^AGED7
KILL ;
K ^UTILITY("DIQ1",$J)
K AG,AGCHRT,AGI,AGLINE,AGOPT,AGPAT,AGSITE,AGUPDT
K AG("DENT"),DFOUT,DIC,DIE,DLOUT,DTOUT,DQOUT,DUOUT,G,AGL,I,L,AGNEW,AGPCC,AGSCRN,AGTEMP,AG("TRBCODE")
K AGXTERN
Q
EMPL ; EP-changes to employer, employment status or spouses employer
N GBL,%,DIE,DIC,DR,DA,X,Y
S GBL=$NA(AGPATCH)
Q:'DFN
S DIE="^AUPNPAT(",DA=DFN,DR=".19;.21;.22;.03////DT;.16////DT;.12////DUZ"
L +^AUPNPAT(DA):0 I $T D ^DIE L -^AUPNPAT(DA)
D NOW^%DTC
S @GBL@(%,DUZ(2),DFN)=""
Q
MCRFL ; EP-medicare alert--person over 64 and not on file with medicare
U 0 W *7,IOINHI,IOBON,"PERSON OVER 64--NO MEDICARE ON FILE!!!",IOINLOW,IOBOFF
Q
VENPCCD1 ; IHS/OIT/GIS - PATIENT DEMOG UPDATE - CONTINUATION ;
+1 ;;2.6;PCC+;;NOV 12, 2007
+2 ;
+3 ;
+4 ;
PI ; EP-PVT INSURANCE
+1 WRITE !,?5,IOUON,IOINHI,"Private Ins.: "
+2 IF $ORDER(^AUPNPRVT(DFN,11,0))=""
WRITE "NONE ON FILE"
QUIT
+3 WRITE IOUOFF,IOINLOW
+4 SET VEN("PI")=0
+5 FOR
SET VEN("PI")=$ORDER(^AUPNPRVT(DFN,11,VEN("PI")))
IF +VEN("PI")=0
QUIT
Begin DoDot:1
+6 SET VENPI=^AUPNPRVT(DFN,11,VEN("PI"),0)
+7 SET VEN("PIN")=$PIECE(^AUTNINS(($PIECE(VENPI,"^",1)),0),"^",1)
+8 SET (VEN("ST"),Y)=$PIECE(VENPI,"^",6)
IF Y'=""
DO DD^%DT
SET VEN("ST")=Y
+9 SET (VEN("EN"),Y)=$PIECE(VENPI,"^",7)
IF Y'=""
DO DD^%DT
SET VEN("EN")=Y
+10 SET VEN("HO")=$PIECE($GET(^AUPN3PPH((+$PIECE(VENPI,"^",8)),0)),U)
+11 WRITE !,?10,VEN("PIN"),!," (Policy Holder: ",VEN("HO")," ) ",VEN("ST")," to ",VEN("EN")
End DoDot:1
+12 QUIT
MDCD ; EP-MEDICAID
+1 NEW MDIEN,START,FIN,TOT,Y
+2 SET TOT=0
+3 SET MDIEN=$ORDER(^AUPNMCD("B",$GET(DFN),0))
IF 'MDIEN
QUIT
+4 WRITE !,?5,IOUON,IOINHI,"Medicaid: (last 4 times eligible)"
+5 IF '$DATA(^AUPNMCD("B",DFN))
WRITE "NONE ON FILE"
QUIT
+6 WRITE IOUOFF,IOINLOW
+7 SET START=9999999
+8 FOR
SET START=$ORDER(^AUPNMCD(MDIEN,11,START),-1)
IF 'START
QUIT
Begin DoDot:1
+9 SET TOT=TOT+1
+10 SET FIN=$PIECE($GET(^AUPNMCD(MDIEN,11,START,0)),U,2)
+11 WRITE !,?10
+12 SET Y=$EXTRACT(START,1,5)
XECUTE ^DD("DD")
WRITE Y
+13 IF 'FIN
WRITE " to ???"
QUIT
+14 SET Y=$EXTRACT(FIN,1,5)
XECUTE ^DD("DD")
WRITE " to ",Y
+15 IF TOT=1
WRITE " (currently eligible)"
QUIT
End DoDot:1
IF TOT>3
QUIT
+16 QUIT
MCR ; EP-MEDICARE
+1 WRITE !,?5,IOUON,IOINHI,"Medicare: "
+2 IF (VEN("AGE")>64)&('$DATA(^AUPNMCR(DFN)))
DO MCRFL
QUIT
+3 IF '$DATA(^AUPNMCR(DFN))
WRITE "NONE ON FILE"
QUIT
+4 WRITE IOUOFF,IOINLOW
+5 SET VEN("MRTY")=""
+6 SET N=0
+7 FOR
SET N=$ORDER(^AUPNMCR(DFN,11,N))
IF +N=0
QUIT
Begin DoDot:1
+8 SET VEN("R")=^AUPNMCR(DFN,11,N,0)
+9 SET (VEN("S"),Y)=$PIECE(VEN("R"),"^",1)
IF Y'=""
DO DD^%DT
SET VEN("S")=Y
+10 SET (VEN("E"),Y)=$PIECE(VEN("R"),"^",2)
IF Y'=""
DO DD^%DT
SET VEN("E")=Y
+11 SET VEN("P")=$PIECE(VEN("R"),"^",3)
+12 WRITE !,?10,"START: ",VEN("S")," to ",VEN("E")," Plan: ",VEN("P")
End DoDot:1
+13 QUIT
PICK ;
+1 SET N=0
+2 KILL VEN("PI")
+3 FOR
SET N=$ORDER(^AUPNPRVT(DFN,11,N))
IF +N=0
QUIT
Begin DoDot:1
+4 SET VEN("R")=^AUPNPRVT(DFN,11,N,0)
+5 SET VEN("END")=$PIECE(VEN("R"),"^",7)
+6 SET VEN("ST")=$PIECE(VEN("R"),"^",6)
+7 SET VEN("IN")=$PIECE(VEN("R"),"^")
SET VEN("IN")=$PIECE($GET(^AUTNINS(VEN("IN"),0)),"^",1)
+8 IF (VEN("END")="")&(DT'<VEN("ST"))
SET VEN("PI",N)=VEN("IN")
QUIT
+9 IF (DT'<VEN("ST"))&(DT'>VEN("END"))
SET VEN("PI",N)=VEN("IN")
QUIT
End DoDot:1
+10 QUIT
ELIG ; EP-edit the elig. information from pat. reg
+1 IF 'DFN
QUIT
+2 SET AGXTERN=""
+3 KILL DIC
+4 DO ^AGVAR
+5 DO DFN^AGEDIT
+6 IF $$VERSION^XPDUTL("AG")["7."
DO VAR^AGED4A
GOTO KILL
+7 DO ^AGED4
DO ^AGED5
DO ^AGED6
DO ^AGED7
KILL ;
+1 KILL ^UTILITY("DIQ1",$JOB)
+2 KILL AG,AGCHRT,AGI,AGLINE,AGOPT,AGPAT,AGSITE,AGUPDT
+3 KILL AG("DENT"),DFOUT,DIC,DIE,DLOUT,DTOUT,DQOUT,DUOUT,G,AGL,I,L,AGNEW,AGPCC,AGSCRN,AGTEMP,AG("TRBCODE")
+4 KILL AGXTERN
+5 QUIT
EMPL ; EP-changes to employer, employment status or spouses employer
+1 NEW GBL,%,DIE,DIC,DR,DA,X,Y
+2 SET GBL=$NAME(AGPATCH)
+3 IF 'DFN
QUIT
+4 SET DIE="^AUPNPAT("
SET DA=DFN
SET DR=".19;.21;.22;.03////DT;.16////DT;.12////DUZ"
+5 LOCK +^AUPNPAT(DA):0
IF $TEST
DO ^DIE
LOCK -^AUPNPAT(DA)
+6 DO NOW^%DTC
+7 SET @GBL@(%,DUZ(2),DFN)=""
+8 QUIT
MCRFL ; EP-medicare alert--person over 64 and not on file with medicare
+1 USE 0
WRITE *7,IOINHI,IOBON,"PERSON OVER 64--NO MEDICARE ON FILE!!!",IOINLOW,IOBOFF
+2 QUIT
