- 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
