AGEVLM1 ; cmi/flag/maw - AGEV Eligibility Verification Events ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
;this routine has several entry points that are called by actions
;on the eligibility list template. It processes entries from the
;INSURANCE ELIGIBILITY HOLDING file.
;
DELETE1 ;-- this will delete one insurance entry from a patient
D SELECT
Q:'$G(AGEVPIEN)
S DIK="^AGEVH(",DA=AGEVPIEN
D ^DIK
Q
;
DELETEA ;-- this will delete all insurance entries from a patient
S AGEVIDA=0
F S AGEVIDA=$O(^AGEVH("B",AGEVPLPT,AGEVIDA)) Q:'AGEVIDA D
. S DIK="^AGEVH(",DA=AGEVIDA
. D ^DIK
.Q
Q
;
FILE1 ;-- this will file one entry into the appropriate insurance file
D SELECT,PRS(AGEVPIEN)
Q
;
PRS(AGEVPIEN) ;-- parse the information from the holding file
;we need to put some sort of verify information here
Q
I '$G(AGEVPIEN) W !,"Error Processing Entry" Q
S AGEVP0=$G(^AGEVH(AGEVPIEN,0))
I '$G(^AGEVH(AGEVPIEN,0)) W !,"Error Processing Entry" Q
S AGEVP1=$G(^AGEVH(AGEVPIEN,1))
I '$G(^AGEVH(AGEVPIEN,1)) W !,"Invalid Insurance Information" Q
S AGEVP2=$G(^AGEVH(AGEVPIEN,2))
S AGEVIIEN=$P(AGEVH0,U)
S (AGEVICN,AGEVINSU)=$P(AGEVP0,U,2)
I AGEVINSU="" W !,"Invalid Insurer, cannot update" Q
S AGEVGN=$P(AGEVP1,U,4)
S AGEVPED=$S($P($G(AGEVP2),U,3):$P(AGEVP2,U,3),1:$P(AGEVP1,U,11))
S AGEVPED=$$FMTE^XLFDT(AGEVPED)
S AGEVPEXD=$S($P($G(AGEVP2),U,4):$P(AGEVP2,U,4),1:$P(AGEVP1,U,12))
S AGEVPEXD=$$FMTE^XLFDT(AGEVPEXD)
S AGEVNOI=$P(AGEVP1,U)
S AGEVIDOB=$P(AGEVP1,13)
S AGEVSTR=$P(AGEVP1,6)
S AGEVCTY=$P(AGEVP1,7)
S AGEVST=$P(AGEVP1,8)
S AGEVZP=$P(AGEVP1,9)
S AGEVGNM=$P(AGEVP1,10)
S AGEVCT=$P(AGEVP1,14)
S AGEVSUF=$P(AGEVP1,16)
S AGEVIID=$P(AGEVP1,3)
S AGEVMST=$P(AGEVP1,15)
S AGEVSX=$P(AGEVP1,5)
S AGEVUP="PI"
I AGEVINSU["MEDICARE" S AGEVUP="MCR"
I AGEVINSU["MEDICAID" S AGEVUP="MCD"
I AGEVINSU["RAILROAD" S AGEVUP="RR"
D @AGEVUP(AGEVIIEN)
Q
;
FILEA ;-- this will file all entries into the appropriate insurance files
S AGEVIDA=0
F S AGEVIDA=$O(^AGEVH("B",AGEVPLPT,AGEVIDA)) Q:'AGEVIDA D
. D PRS(AGEVIDA)
.Q
Q
;
SELECT ;get record
S AGEVPIEN=0
D EN^VALM2(XQORNOD(0),"OS") ;this allows user to select an entry
I '$D(VALMY) W !,"No entry selected." Q
S AGEVP=$O(VALMY(0))
I 'AGEVP KILL AGEVP,VALMY,XQORNOD W !,"No record selected." Q
S (X,Y)=0
F S X=$O(^TMP("AGEV",$J,"IDX",X)) Q:X'=+X!(AGEVPIEN) I $O(^TMP("AGEV",$J,"IDX",X,0))=AGEVP S Y=$O(^TMP("AGEV",$J,"IDX",X,0)),AGEVPIEN=^TMP("AGEV",$J,"IDX",X,Y)
I '$D(^AGEVH(AGEVPIEN,0)) D Q
. W !,"Not a valid entry."
. KILL APCDP
. S APCDPIEN=0
.Q
D FULL^VALM1 ;give me full control of screen
Q
;
MCR(AGEVIIEN) ;-- update medicare
D MCR^AGEVINU(AGEVIIEN)
Q
;
MCD(AGEVIIEN) ;-- update medicaid
D MCD^AGEVINU(AGEVIIEN)
Q
;
RR(AGEVIIEN) ;-- update railroad
;D RR^AGEVINU(AGEVIIEN) ;not implemented yet
Q
;
PI(AGEVIIEN) ;-- update private insurance and policy holder
D PI^AGEVINU(AGEVIIEN)
Q
AGEVLM1 ; cmi/flag/maw - AGEV Eligibility Verification Events ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
+3 ;this routine has several entry points that are called by actions
+4 ;on the eligibility list template. It processes entries from the
+5 ;INSURANCE ELIGIBILITY HOLDING file.
+6 ;
DELETE1 ;-- this will delete one insurance entry from a patient
+1 DO SELECT
+2 IF '$GET(AGEVPIEN)
QUIT
+3 SET DIK="^AGEVH("
SET DA=AGEVPIEN
+4 DO ^DIK
+5 QUIT
+6 ;
DELETEA ;-- this will delete all insurance entries from a patient
+1 SET AGEVIDA=0
+2 FOR
SET AGEVIDA=$ORDER(^AGEVH("B",AGEVPLPT,AGEVIDA))
IF 'AGEVIDA
QUIT
Begin DoDot:1
+3 SET DIK="^AGEVH("
SET DA=AGEVIDA
+4 DO ^DIK
+5 QUIT
End DoDot:1
+6 QUIT
+7 ;
FILE1 ;-- this will file one entry into the appropriate insurance file
+1 DO SELECT
DO PRS(AGEVPIEN)
+2 QUIT
+3 ;
PRS(AGEVPIEN) ;-- parse the information from the holding file
+1 ;we need to put some sort of verify information here
+2 QUIT
+3 IF '$GET(AGEVPIEN)
WRITE !,"Error Processing Entry"
QUIT
+4 SET AGEVP0=$GET(^AGEVH(AGEVPIEN,0))
+5 IF '$GET(^AGEVH(AGEVPIEN,0))
WRITE !,"Error Processing Entry"
QUIT
+6 SET AGEVP1=$GET(^AGEVH(AGEVPIEN,1))
+7 IF '$GET(^AGEVH(AGEVPIEN,1))
WRITE !,"Invalid Insurance Information"
QUIT
+8 SET AGEVP2=$GET(^AGEVH(AGEVPIEN,2))
+9 SET AGEVIIEN=$PIECE(AGEVH0,U)
+10 SET (AGEVICN,AGEVINSU)=$PIECE(AGEVP0,U,2)
+11 IF AGEVINSU=""
WRITE !,"Invalid Insurer, cannot update"
QUIT
+12 SET AGEVGN=$PIECE(AGEVP1,U,4)
+13 SET AGEVPED=$SELECT($PIECE($GET(AGEVP2),U,3):$PIECE(AGEVP2,U,3),1:$PIECE(AGEVP1,U,11))
+14 SET AGEVPED=$$FMTE^XLFDT(AGEVPED)
+15 SET AGEVPEXD=$SELECT($PIECE($GET(AGEVP2),U,4):$PIECE(AGEVP2,U,4),1:$PIECE(AGEVP1,U,12))
+16 SET AGEVPEXD=$$FMTE^XLFDT(AGEVPEXD)
+17 SET AGEVNOI=$PIECE(AGEVP1,U)
+18 SET AGEVIDOB=$PIECE(AGEVP1,13)
+19 SET AGEVSTR=$PIECE(AGEVP1,6)
+20 SET AGEVCTY=$PIECE(AGEVP1,7)
+21 SET AGEVST=$PIECE(AGEVP1,8)
+22 SET AGEVZP=$PIECE(AGEVP1,9)
+23 SET AGEVGNM=$PIECE(AGEVP1,10)
+24 SET AGEVCT=$PIECE(AGEVP1,14)
+25 SET AGEVSUF=$PIECE(AGEVP1,16)
+26 SET AGEVIID=$PIECE(AGEVP1,3)
+27 SET AGEVMST=$PIECE(AGEVP1,15)
+28 SET AGEVSX=$PIECE(AGEVP1,5)
+29 SET AGEVUP="PI"
+30 IF AGEVINSU["MEDICARE"
SET AGEVUP="MCR"
+31 IF AGEVINSU["MEDICAID"
SET AGEVUP="MCD"
+32 IF AGEVINSU["RAILROAD"
SET AGEVUP="RR"
+33 DO @AGEVUP(AGEVIIEN)
+34 QUIT
+35 ;
FILEA ;-- this will file all entries into the appropriate insurance files
+1 SET AGEVIDA=0
+2 FOR
SET AGEVIDA=$ORDER(^AGEVH("B",AGEVPLPT,AGEVIDA))
IF 'AGEVIDA
QUIT
Begin DoDot:1
+3 DO PRS(AGEVIDA)
+4 QUIT
End DoDot:1
+5 QUIT
+6 ;
SELECT ;get record
+1 SET AGEVPIEN=0
+2 ;this allows user to select an entry
DO EN^VALM2(XQORNOD(0),"OS")
+3 IF '$DATA(VALMY)
WRITE !,"No entry selected."
QUIT
+4 SET AGEVP=$ORDER(VALMY(0))
+5 IF 'AGEVP
KILL AGEVP,VALMY,XQORNOD
WRITE !,"No record selected."
QUIT
+6 SET (X,Y)=0
+7 FOR
SET X=$ORDER(^TMP("AGEV",$JOB,"IDX",X))
IF X'=+X!(AGEVPIEN)
QUIT
IF $ORDER(^TMP("AGEV",$JOB,"IDX",X,0))=AGEVP
SET Y=$ORDER(^TMP("AGEV",$JOB,"IDX",X,0))
SET AGEVPIEN=^TMP("AGEV",$JOB,"IDX",X,Y)
+8 IF '$DATA(^AGEVH(AGEVPIEN,0))
Begin DoDot:1
+9 WRITE !,"Not a valid entry."
+10 KILL APCDP
+11 SET APCDPIEN=0
+12 QUIT
End DoDot:1
QUIT
+13 ;give me full control of screen
DO FULL^VALM1
+14 QUIT
+15 ;
MCR(AGEVIIEN) ;-- update medicare
+1 DO MCR^AGEVINU(AGEVIIEN)
+2 QUIT
+3 ;
MCD(AGEVIIEN) ;-- update medicaid
+1 DO MCD^AGEVINU(AGEVIIEN)
+2 QUIT
+3 ;
RR(AGEVIIEN) ;-- update railroad
+1 ;D RR^AGEVINU(AGEVIIEN) ;not implemented yet
+2 QUIT
+3 ;
PI(AGEVIIEN) ;-- update private insurance and policy holder
+1 DO PI^AGEVINU(AGEVIIEN)
+2 QUIT
