VENPCCD ; IHS/OIT/GIS - UPDATE DEMOGRAPHICS AND INSURANCE INFO ;
;;2.6;PCC+;;NOV 12, 2007
;
;
;
PAT(DFN) ; EP-UPDATE DEMOGRAPHICS
N VENA,VENPI,N,SEX,SSN,AGE,DOB,D0,IOEDEOP,IOINHI,IOINLOW,IOINORM,IORVOFF,IORVON,IOUOFF,IOUON,X,VEN,Y,I,IOBOFF,IOBON,%,VEND,DIPGM,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,DA,DIC,DR,DIQ,D0,DLAYGO,VENPAT
D ^XBKVAR
S X="IOEDEOP;IORVON;IORVOFF;IOBOFF;IOBON;IOINHI;IOINORM;IOINLOW;IOUOFF;IOUON" D ENDR^%ZISS
S VEND("EMPST")=$P(^DD(9000001,.21,0),"^",3)
START ;
K VEN
S DIC="^AUPNPAT(",DIC(0)="",X="`"_DFN,DLAYGO=9000001 D ^DIC K DIC
I $D(DFN) D PROCESS
I $D(DFN),$L($T(UPDATE1^AGED)),$P($G(^VEN(7.5,CFIGIEN,0)),U,20) D PAGE11(DFN)
G END
PROCESS ; EP - DRIVER
L ^AUPNPAT(DFN,0):0 I '$T W !!,*7,"Patient is being edited by someone else!!" H 1 Q ;G START
S VEN(0)=^DPT(DFN,0)
S DIC=2,DA=DFN,DR=.033,DIQ="VENA" D EN^DIQ1 S VEN("AGE")=VENA(2,DFN,.033)
S VEN("SSN")=$P(VEN(0),"^",9)
S VEN("HPHONE")=$P($G(^DPT(DFN,.13)),"^",1)
S VEN("OPHONE")=$P($G(^DPT(DFN,.13)),"^",2)
S VEN("N")=$P(VEN(0),"^",1)
S VEN("HRN")=$P(^AUPNPAT(DFN,41,DUZ(2),0),"^",2)
S %=$P($G(^DPT(DFN,0)),U,3) I %'?7N W !,"Missing/invalid DOB!!!" Q
S AGE=(DT-%)\10000
I (AGE>64)&('$D(^AUPNMCR(DFN))) S VEN("MRCK")="Y"
DISPLAY I '$G(CHECKIN) D ^XBCLS I 1
E W !!
U 0 W ?5,IOUON,IOINHI,"Patient: ",IOUOFF,IOINLOW,VEN("N"),?69,IOUON,IOINHI,"HRN: ",IOUOFF,IOINLOW,VEN("HRN")
ADD ;
S VEN(.11)=$G(^DPT(DFN,.11))
F I=1:1:6 S VEN("A",I)=$P(VEN(.11),"^",I)
I VEN("A",5)'="" S VEN("A",5)=$P(^DIC(5,VEN("A",5),0),"^",1)
W !,?5,IOUON,IOINHI,"SSN: ",IOUOFF,IOINLOW,VEN("SSN")
W !,?5,IOUON,IOINHI,"HOME PHONE: ",IOUOFF,IOINLOW,VEN("HPHONE")
W !,?5,IOUON,IOINHI,"OFFICE PHONE: ",IOUOFF,IOINLOW,VEN("OPHONE")
W !!,?5,IOUON,IOINHI,"Address: ",IOUOFF,IOINLOW,VEN("A",1) I VEN("A",2)'="" W !,?14,VEN("A",2)
I VEN("A",3)'="" W !,?14,VEN("A",3)
W !,?14,VEN("A",4),", ",VEN("A",5)," ",VEN("A",6)
S DIR("A")="SSN, Phone or Address Change",DIR("B")="N",DIR(0)="Y"
W IOINHI D ^DIR W IOINLOW
I $D(DTOUT)!($D(DUOUT)) G END
I Y=1 D ADDCHG G DISPLAY
D INCHG G DISPLAY:VEN("ICHG")="Y"
D EMPCHG
D MDCDFL
I (VEN("AGE")>64)&('$D(^AUPNMCR(DFN))) D MCRFL
G END
ADDCHG ; call routine that changes address fields in pat reg
;makes sure change the date last edit,who edited and agpatch also
N GBL,%,DIE,DA,DR,X,Y,DIC
S GBL=$NA(^AGPATCH)
S DIE="^DPT(",DA=DFN,DR=".09;.131;.132;.111;.112;.113;.114;.115;.116"
L +^DPT(DA):0 I $T D ^DIE L -^DPT(DA)
S DIE="^AUPNPAT(",DA=DFN,DR=".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
INCHG ; changes in the insurance plan
S VEN("ICHG")="N"
W !
I $D(^AUPNPRVT(DFN)) D PI^VENPCCD1
I $$MOK(DFN) D MDCD^VENPCCD1
D MCR^VENPCCD1
S DIR("A")="Any 3rd Party Rescource Changes",DIR("B")="N",DIR(0)="Y"
W IOINHI D ^DIR W IOINLOW
I $D(DTOUT)!($D(DUOUT)) Q
K DIR
I Y=1 D ELIG^VENPCCD1 S VEN("ICHG")="Y"
Q
MOK(DFN) ; IS PT MEDICAID ELIGIBLE?
N MDIEN,START,END
S MDIEN=$O(^AUPNMCD("B",+$G(DFN),0)) I 'MDIEN Q 0
S START=$O(^AUPNMCD(MDIEN,11,9999999),-1) I 'START Q 0
S END=$P($G(^AUPNMCD(MDIEN,11,START,0)),U,2)
I END<DT Q 0
Q 1
;
EMPCHG ; changes in the employment, employment status, or spouse employment
S VEN("$Y")=$Y
S VEN(0)=^AUPNPAT(DFN,0)
S VEN("E")=$P(VEN(0),"^",19) I VEN("E")'="" S VEN("E")=$P(^AUTNEMPL(VEN("E"),0),"^",1)
S VEN("ES")=$P(VEN(0),"^",21) I VEN("ES")'="" S VEN("ES")=$P(VEND("EMPST"),(VEN("ES")_":"),2),VEN("ES")=$P(VEN("ES"),";",1)
S VEN("SE")=$P(VEN(0),"^",22) I VEN("SE")'="" S VEN("SE")=$P(^AUTNEMPL(VEN("SE"),0),"^",1)
W !!,?5,IOUON,IOINHI,"Employer: ",IOUOFF,IOINLOW,VEN("E")," ",IOUON,IOINHI,"Status: ",IOUOFF,IOINLOW,VEN("ES")
I VEN("SE")'="" W !,?5,IOUON,IOINHI,"Spouse's Employer: ",IOUOFF,IOINLOW,VEN("SE")
S DIR("A")="Any Changes in Employment",DIR("B")="N",DIR(0)="Y"
W IOINHI D ^DIR W IOINLOW
I $D(DTOUT)!($D(DUOUT)) Q
I Y=1 D EMPL^VENPCCD1 S VEN("ECHG")="Y",$Y=VEN("$Y") W IOEDEOP S $Y=VEN("$Y")
W !
Q
MDCDFL ; medicaid alert for passport signature
I $D(VEN("MDCD")) D
.W IORVON,*7
.S DIR("A",1)="Patient is currently on Medicaid and must sign Passport form."
.S DIR("A")="Has this been COMPLETED"
.S DIR(0)="Y"
.S DIR("B")="Y"
.D ^DIR
.I Y=1 S VEN("COMP")="Y"
.I Y=0 S VEN("COMP")="N"
.I '$D(VENPAT("MDCD",DFN)) S VENPAT("MDCD",DFN)=DT_"^"_DUZ_"^"_VEN("COMP")
.S VEN("M")=VENPAT("MDCD",DFN)
.S $P(VEN("M"),"^",4)=DT
.S $P(VEN("M"),"^",5)=DUZ
.S $P(VEN("M"),"^",6)=VEN("COMP")
.S VENPAT("MDCD",DFN)=VEN("M")
K DIR
W IORVOFF
Q
MCRFL ; medicare alert--person over 65 and not on file with medicare
U 0 W *7,IORVON,IOBON,!,?5,"PERSON OVER 65--NO MEDICARE ON FILE!!!",IORVOFF,IOBOFF
I '$D(VENPAT("MCR",DFN)) S VENPAT("MCR",DFN)=DT_"^"_DUZ
D NOW^%DTC
S VENPAT("MCR",DFN,%)=DUZ
;THE VENPAT("MCR",DFN) node contains the initial time that the user
;was alerted to see person wasn't on file with Medicare & is over 64
;the next nodes with % is the times after that the user is alerted that
;the person is not on file with medicare
Q
END ;
Q
PAGE11(DFN) ; EP-EDIT PAGE 11
N DA,DR,DIE
W !!,"Want to enter additional registration information (Page 11)"
S %=2 D YN^DICN I %'=1 Q
S DIE=9000001,DR=1301,DA=DFN
L +^AUPNPAT(DA):0 I $T D ^DIE L -^AUPNPAT(DA)
D UPDATE1^AGED(DUZ(2),DFN,11,"")
D ^XBFMK
Q
;
VENPCCD ; IHS/OIT/GIS - UPDATE DEMOGRAPHICS AND INSURANCE INFO ;
+1 ;;2.6;PCC+;;NOV 12, 2007
+2 ;
+3 ;
+4 ;
PAT(DFN) ; EP-UPDATE DEMOGRAPHICS
+1 NEW VENA,VENPI,N,SEX,SSN,AGE,DOB,D0,IOEDEOP,IOINHI,IOINLOW,IOINORM,IORVOFF,IORVON,IOUOFF,IOUON,X,VEN,Y,I,IOBOFF,IOBON,%,VEND,DIPGM,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,DA,DIC,DR,DIQ,D0,DLAYGO,VENPAT
+2 DO ^XBKVAR
+3 SET X="IOEDEOP;IORVON;IORVOFF;IOBOFF;IOBON;IOINHI;IOINORM;IOINLOW;IOUOFF;IOUON"
DO ENDR^%ZISS
+4 SET VEND("EMPST")=$PIECE(^DD(9000001,.21,0),"^",3)
START ;
+1 KILL VEN
+2 SET DIC="^AUPNPAT("
SET DIC(0)=""
SET X="`"_DFN
SET DLAYGO=9000001
DO ^DIC
KILL DIC
+3 IF $DATA(DFN)
DO PROCESS
+4 IF $DATA(DFN)
IF $LENGTH($TEXT(UPDATE1^AGED))
IF $PIECE($GET(^VEN(7.5,CFIGIEN,0)),U,20)
DO PAGE11(DFN)
+5 GOTO END
PROCESS ; EP - DRIVER
+1 ;G START
LOCK ^AUPNPAT(DFN,0):0
IF '$TEST
WRITE !!,*7,"Patient is being edited by someone else!!"
HANG 1
QUIT
+2 SET VEN(0)=^DPT(DFN,0)
+3 SET DIC=2
SET DA=DFN
SET DR=.033
SET DIQ="VENA"
DO EN^DIQ1
SET VEN("AGE")=VENA(2,DFN,.033)
+4 SET VEN("SSN")=$PIECE(VEN(0),"^",9)
+5 SET VEN("HPHONE")=$PIECE($GET(^DPT(DFN,.13)),"^",1)
+6 SET VEN("OPHONE")=$PIECE($GET(^DPT(DFN,.13)),"^",2)
+7 SET VEN("N")=$PIECE(VEN(0),"^",1)
+8 SET VEN("HRN")=$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),"^",2)
+9 SET %=$PIECE($GET(^DPT(DFN,0)),U,3)
IF %'?7N
WRITE !,"Missing/invalid DOB!!!"
QUIT
+10 SET AGE=(DT-%)\10000
+11 IF (AGE>64)&('$DATA(^AUPNMCR(DFN)))
SET VEN("MRCK")="Y"
DISPLAY IF '$GET(CHECKIN)
DO ^XBCLS
IF 1
+1 IF '$TEST
WRITE !!
+2 USE 0
WRITE ?5,IOUON,IOINHI,"Patient: ",IOUOFF,IOINLOW,VEN("N"),?69,IOUON,IOINHI,"HRN: ",IOUOFF,IOINLOW,VEN("HRN")
ADD ;
+1 SET VEN(.11)=$GET(^DPT(DFN,.11))
+2 FOR I=1:1:6
SET VEN("A",I)=$PIECE(VEN(.11),"^",I)
+3 IF VEN("A",5)'=""
SET VEN("A",5)=$PIECE(^DIC(5,VEN("A",5),0),"^",1)
+4 WRITE !,?5,IOUON,IOINHI,"SSN: ",IOUOFF,IOINLOW,VEN("SSN")
+5 WRITE !,?5,IOUON,IOINHI,"HOME PHONE: ",IOUOFF,IOINLOW,VEN("HPHONE")
+6 WRITE !,?5,IOUON,IOINHI,"OFFICE PHONE: ",IOUOFF,IOINLOW,VEN("OPHONE")
+7 WRITE !!,?5,IOUON,IOINHI,"Address: ",IOUOFF,IOINLOW,VEN("A",1)
IF VEN("A",2)'=""
WRITE !,?14,VEN("A",2)
+8 IF VEN("A",3)'=""
WRITE !,?14,VEN("A",3)
+9 WRITE !,?14,VEN("A",4),", ",VEN("A",5)," ",VEN("A",6)
+10 SET DIR("A")="SSN, Phone or Address Change"
SET DIR("B")="N"
SET DIR(0)="Y"
+11 WRITE IOINHI
DO ^DIR
WRITE IOINLOW
+12 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO END
+13 IF Y=1
DO ADDCHG
GOTO DISPLAY
+14 DO INCHG
IF VEN("ICHG")="Y"
GOTO DISPLAY
+15 DO EMPCHG
+16 DO MDCDFL
+17 IF (VEN("AGE")>64)&('$DATA(^AUPNMCR(DFN)))
DO MCRFL
+18 GOTO END
ADDCHG ; call routine that changes address fields in pat reg
+1 ;makes sure change the date last edit,who edited and agpatch also
+2 NEW GBL,%,DIE,DA,DR,X,Y,DIC
+3 SET GBL=$NAME(^AGPATCH)
+4 SET DIE="^DPT("
SET DA=DFN
SET DR=".09;.131;.132;.111;.112;.113;.114;.115;.116"
+5 LOCK +^DPT(DA):0
IF $TEST
DO ^DIE
LOCK -^DPT(DA)
+6 SET DIE="^AUPNPAT("
SET DA=DFN
SET DR=".03////"_DT_";.16////"_DT_";.12////"_DUZ
+7 LOCK +^AUPNPAT(DA):0
IF $TEST
DO ^DIE
LOCK -^AUPNPAT(DA)
+8 DO NOW^%DTC
+9 SET @GBL@(%,DUZ(2),DFN)=""
+10 QUIT
INCHG ; changes in the insurance plan
+1 SET VEN("ICHG")="N"
+2 WRITE !
+3 IF $DATA(^AUPNPRVT(DFN))
DO PI^VENPCCD1
+4 IF $$MOK(DFN)
DO MDCD^VENPCCD1
+5 DO MCR^VENPCCD1
+6 SET DIR("A")="Any 3rd Party Rescource Changes"
SET DIR("B")="N"
SET DIR(0)="Y"
+7 WRITE IOINHI
DO ^DIR
WRITE IOINLOW
+8 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+9 KILL DIR
+10 IF Y=1
DO ELIG^VENPCCD1
SET VEN("ICHG")="Y"
+11 QUIT
MOK(DFN) ; IS PT MEDICAID ELIGIBLE?
+1 NEW MDIEN,START,END
+2 SET MDIEN=$ORDER(^AUPNMCD("B",+$GET(DFN),0))
IF 'MDIEN
QUIT 0
+3 SET START=$ORDER(^AUPNMCD(MDIEN,11,9999999),-1)
IF 'START
QUIT 0
+4 SET END=$PIECE($GET(^AUPNMCD(MDIEN,11,START,0)),U,2)
+5 IF END<DT
QUIT 0
+6 QUIT 1
+7 ;
EMPCHG ; changes in the employment, employment status, or spouse employment
+1 SET VEN("$Y")=$Y
+2 SET VEN(0)=^AUPNPAT(DFN,0)
+3 SET VEN("E")=$PIECE(VEN(0),"^",19)
IF VEN("E")'=""
SET VEN("E")=$PIECE(^AUTNEMPL(VEN("E"),0),"^",1)
+4 SET VEN("ES")=$PIECE(VEN(0),"^",21)
IF VEN("ES")'=""
SET VEN("ES")=$PIECE(VEND("EMPST"),(VEN("ES")_":"),2)
SET VEN("ES")=$PIECE(VEN("ES"),";",1)
+5 SET VEN("SE")=$PIECE(VEN(0),"^",22)
IF VEN("SE")'=""
SET VEN("SE")=$PIECE(^AUTNEMPL(VEN("SE"),0),"^",1)
+6 WRITE !!,?5,IOUON,IOINHI,"Employer: ",IOUOFF,IOINLOW,VEN("E")," ",IOUON,IOINHI,"Status: ",IOUOFF,IOINLOW,VEN("ES")
+7 IF VEN("SE")'=""
WRITE !,?5,IOUON,IOINHI,"Spouse's Employer: ",IOUOFF,IOINLOW,VEN("SE")
+8 SET DIR("A")="Any Changes in Employment"
SET DIR("B")="N"
SET DIR(0)="Y"
+9 WRITE IOINHI
DO ^DIR
WRITE IOINLOW
+10 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+11 IF Y=1
DO EMPL^VENPCCD1
SET VEN("ECHG")="Y"
SET $Y=VEN("$Y")
WRITE IOEDEOP
SET $Y=VEN("$Y")
+12 WRITE !
+13 QUIT
MDCDFL ; medicaid alert for passport signature
+1 IF $DATA(VEN("MDCD"))
Begin DoDot:1
+2 WRITE IORVON,*7
+3 SET DIR("A",1)="Patient is currently on Medicaid and must sign Passport form."
+4 SET DIR("A")="Has this been COMPLETED"
+5 SET DIR(0)="Y"
+6 SET DIR("B")="Y"
+7 DO ^DIR
+8 IF Y=1
SET VEN("COMP")="Y"
+9 IF Y=0
SET VEN("COMP")="N"
+10 IF '$DATA(VENPAT("MDCD",DFN))
SET VENPAT("MDCD",DFN)=DT_"^"_DUZ_"^"_VEN("COMP")
+11 SET VEN("M")=VENPAT("MDCD",DFN)
+12 SET $PIECE(VEN("M"),"^",4)=DT
+13 SET $PIECE(VEN("M"),"^",5)=DUZ
+14 SET $PIECE(VEN("M"),"^",6)=VEN("COMP")
+15 SET VENPAT("MDCD",DFN)=VEN("M")
End DoDot:1
+16 KILL DIR
+17 WRITE IORVOFF
+18 QUIT
MCRFL ; medicare alert--person over 65 and not on file with medicare
+1 USE 0
WRITE *7,IORVON,IOBON,!,?5,"PERSON OVER 65--NO MEDICARE ON FILE!!!",IORVOFF,IOBOFF
+2 IF '$DATA(VENPAT("MCR",DFN))
SET VENPAT("MCR",DFN)=DT_"^"_DUZ
+3 DO NOW^%DTC
+4 SET VENPAT("MCR",DFN,%)=DUZ
+5 ;THE VENPAT("MCR",DFN) node contains the initial time that the user
+6 ;was alerted to see person wasn't on file with Medicare & is over 64
+7 ;the next nodes with % is the times after that the user is alerted that
+8 ;the person is not on file with medicare
+9 QUIT
END ;
+1 QUIT
PAGE11(DFN) ; EP-EDIT PAGE 11
+1 NEW DA,DR,DIE
+2 WRITE !!,"Want to enter additional registration information (Page 11)"
+3 SET %=2
DO YN^DICN
IF %'=1
QUIT
+4 SET DIE=9000001
SET DR=1301
SET DA=DFN
+5 LOCK +^AUPNPAT(DA):0
IF $TEST
DO ^DIE
LOCK -^AUPNPAT(DA)
+6 DO UPDATE1^AGED(DUZ(2),DFN,11,"")
+7 DO ^XBFMK
+8 QUIT
+9 ;
