AGEVLM ; cmi/flag/maw - AGEV Insurance Eligibility Verification ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
MAIN ;-- main routine driver
W:$D(IOF) @IOF
F J=1:1:5 S X=$P($T(TEXT+J),";;",2) W !?80-$L(X)\2,X
KILL X,J
W !!
S AGEVPLPT=""
F D GETPAT Q:AGEVPLPT="" S DFN=AGEVPLPT D EN1,FULL^VALM1,EXIT K AGEVPLPT
D EOJ
Q
;
GETPAT ;-- get patient
KILL AGEVPLPT,AGEVLOC,AGEVPAT,AGEVDATE,AGEVPIEN,AGEVAF,AGEVPRB,AGEVOVRR
KILL AGEVLOOK,AGEVPDFN
D KILL^AUPNPAT
S AGEVPLPT=""
W !
S DIC="^AGEVH(",DIC(0)="AEMQ"
D ^DIC
KILL DIC
Q:Y<0
S AGEVF=+Y,AGEVPLPT=$P(Y,U,2)
Q
;
EOJ ;-- end of job cleanup
D:$D(VALMWD) CLEAR^VALM1 ;clears out all list man stuff
K XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF
K VALMMCON,VALMDN,VALMEVL,VALMIOXY,VALMKEY,VALMLFT,VALMLST,VALMMENU
K VALMSGR,VALMUP,VALMWD,VALMY,XQORS,XQORSPEW
K AGEVPLPT,AGEVLOC,AGEVPAT,AGEVDATE,AGEVPIEN,AGEVAF,AGEVPRB,AGEVOVRR
K AGEVLOOK,AGEVPDFN
D KILL^AUPNPAT,EN^XBVK("BHLX"),EN^XBVK("AGEV")
Q
;
EN1 ;PEP - requires DFN to be set to patient
Q:'$G(DFN)
S AGEVPLPT=DFN
Q:'$G(AGEVPLPT)
Q:'$D(^AUPNPAT(AGEVPLPT))
Q:'$D(^DPT(AGEVPLPT))
S Y=AGEVPLPT
D ^AUPNPAT,EN
KILL AGEVPLPT
D FULL^VALM1,EXIT
Q
;
EN ;PEP - main entry point for AGEV ELIGIBILITY VERIFICATION
S VALMCC=1 ;1 means screen mode, 0 means scrolling mode
D EN^VALM("AGEV ELIGIBILITY VERIFICATION"),CLEAR^VALM1
Q
;
HDR ;EP - header code
S VALMHDR(1)=$TR($J(" ",80)," ","-")
S VALMHDR(2)="Name: "_IORVON_$E($P(^DPT(AGEVPLPT,0),U),1,30)_IOINORM
S VALMHDR(2)=VALMHDR(2)_" DOB: "_$$FTIME^VALM1(AUPNDOB)_" Sex: "
S VALMHDR(2)=VALMHDR(2)_$P(^DPT(AGEVPLPT,0),U,2)_" HRN: "
S VALMHDR(2)=VALMHDR(2)_$S($D(^AUPNPAT(AGEVPLPT,41,DUZ(2),0)):$P(^AUPNPAT(AGEVPLPT,41,DUZ(2),0),U,2),1:"????")
S VALMHDR(3)=$TR($J(" ",80)," ","-")
Q
;
INIT ;-- init variables and list array
D GATHER
S VALMCNT=AGEVLINE ;this variable must be the total number of line
Q
;
GATHER ;EP - this gets the particular patient
;set up array containing insurances for the patient
;**** see page 7 of List Manager Manual for info on how to
;**** set up the array that contains the list
KILL AGEVQUIT,AGEVPL
S (AGEVCNT,AGEVRCNT,AGEVLINE)=0
I '$O(^AGEVH("B",AGEVPLPT,0)) D Q
. S ^TMP("AGEV",$J,1,0)="No insurance entries currently on file"
. S ^TMP("AGEV",$J,"IDX",1,1)=""
. S AGEVRCNT=1
.Q
S AGEVAF="A"
D GATHER1
Q
;
GATHER1 ;-- this gets the patient and policy holder information
Q:'$G(^AGEVH(AGEVF,0))
S AGEVH0=$G(^AGEVH(AGEVF,0)),AGEVH1=$G(^AGEVH(AGEVF,1))
Q:AGEVH1=""
S AGEVINS=$P(AGEVH0,U,2)
Q:AGEVINS=""
S AGEVPOLH=$P(AGEVH1,U)
S AGEVPOLN=$P(AGEVH1,U,3)
S AGEVPOLG=$P(AGEVH1,U,4)
S AGEVPHSX=$P(AGEVH1,U,5)
S AGEVPST=$P(AGEVH1,U,8)
S AGEVPDOB=$$FMTE^XLFDT($P(AGEVH1,U,10))
D SUB,DEP
I $$GET1^DIQ(9999999.18,AGEVINS,.01)["MEDICAID" D MCD^AGEVLM0 Q
I $$GET1^DIQ(9999999.18,AGEVINS,.01)["MEDICARE" D MCR^AGEVLM0 Q
I $$GET1^DIQ(9999999.18,AGEVINS,.01)["RAILROAD" D RR^AGEVLM0 Q
D PI^AGEVLM0
Q
;
SUB ;-- this gets the subscriber information
S AGEVHDA=0
F S AGEVHDA=$O(^AGEVH(AGEVF,2,AGEVHDA)) Q:'AGEVHDA D
. S AGEV("SUB REQ VAL",AGEVHDA)=$G(^AGEVH(AGEVF,2,AGEVHDA,0))
.Q
S AGEVHDA=0
F S AGEVHDA=$O(^AGEVH(AGEVF,2.5,AGEVHDA)) Q:'AGEVHDA D
. S AGEV("SUB DTP",AGEVHDA)=$P($G(^AGEVH(AGEVF,2.5,AGEVHDA,0)),U)
. S $P(AGEV("SUB DTP",AGEVHDA),U,2)=$P($G(^AGEVH(AGEVF,2.5,AGEVHDA,0)),U,2)
.Q
S AGEVHDA=0
F S AGEVHDA=$O(^AGEVH(AGEVF,3,AGEVHDA)) Q:'AGEVHDA D
. S AGEV("SUB ELG INFO",AGEVHDA)=$P($G(^AGEVH(AGEVF,3,AGEVHDA,0)),U)
. S $P(AGEV("SUB ELG INFO",AGEVHDA),U,2)=$P($G(^AGEVH(AGEVF,3,AGEVHDA,0)),U,2)
. S $P(AGEV("SUB ELG INFO",AGEVHDA),U,3)=$P($G(^AGEVH(AGEVF,3,AGEVHDA,0)),U,3)
. S AGEVADA=0
. F S AGEVADA=$O(^AGEVH(AGEVF,3,AGEVHDA,"REF",AGEVADA)) Q:'AGEVADA D
.. S AGEV("SUB REF ID",AGEVHDA,AGEVADA)=$P($G(^AGEVH(AGEVF,3,AGEVHDA,"REF",AGEVADA,0)),U)
.. S $P(AGEV("SUB REF ID",AGEVHDA,AGEVADA),U,2)=$P($G(^AGEVH(AGEVF,3,AGEVHDA,"REF",AGEVADA,0)),U,2)
..Q
. S AGEVADA=0
. F S AGEVADA=$O(^AGEVH(AGEVF,3,AGEVHDA,"AAA",AGEVADA)) Q:'AGEVADA D
.. S AGEV("SUB ELG REQ VAL",AGEVHDA,AGEVADA)=$G(^AGEVH(AGEVF,3,AGEVHDA,"AAA",AGEVADA,0))
..Q
. S AGEVADA=0
. F S AGEVADA=$O(^AGEVH(AGEVF,3,AGEVHDA,"DTP",AGEVADA)) Q:'AGEVADA D
.. S AGEV("SUB ELG DTP",AGEVHDA,AGEVADA)=$P($G(^AGEVH(AGEVF,3,AGEVHDA,"DTP",AGEVADA,0)),U)
.. S $P(AGEV("SUB ELG DTP",AGEVHDA,AGEVADA),U,2)=$P($G(^AGEVH(AGEVF,3,AGEVHDA,"DTP",AGEVADA,0)),U,2)
..Q
. S AGEVADA=0
. F S AGEVADA=$O(^AGEVH(AGEVF,3,AGEVHDA,"MSG",AGEVADA)) Q:'AGEVADA D
.. S AGEV("SUB ELG MSG",AGEVHDA,AGEVADA)=$G(^AGEVH(AGEVF,3,AGEVHDA,"MSG",AGEVADA,0))
..Q
.Q
Q
;
DEP ;-- this gets the dependent information
S AGEVHDA=0
F S AGEVHDA=$O(^AGEVH(AGEVF,4,AGEVHDA)) Q:'AGEVHDA D
. S AGEV("DEP REQ VAL",AGEVHDA)=$G(^AGEVH(AGEVF,4,AGEVHDA,0))
.Q
S AGEVHDA=0
F S AGEVHDA=$O(^AGEVH(AGEVF,4.5,AGEVHDA)) Q:'AGEVHDA D
. S AGEV("DEP DTP",AGEVHDA)=$P($G(^AGEVH(AGEVF,4.5,AGEVHDA,0)),U)
. S $P(AGEV("DEP DTP",AGEVHDA),U,2)=$P($G(^AGEVH(AGEVF,4.5,AGEVHDA,0)),U,2)
S AGEVHDA=0 F S AGEVHDA=$O(^AGEVH(AGEVF,5,AGEVHDA)) Q:'AGEVHDA D
. S AGEV("DEP ELG INFO",AGEVHDA)=$P($G(^AGEVH(AGEVF,5,AGEVHDA,0)),U)
. S $P(AGEV("DEP ELG INFO",AGEVHDA),U,2)=$P($G(^AGEVH(AGEVF,5,AGEVHDA,0)),U,2)
. S $P(AGEV("DEP ELG INFO",AGEVHDA),U,3)=$P($G(^AGEVH(AGEVF,5,AGEVHDA,0)),U,3)
. S AGEVADA=0
. F S AGEVADA=$O(^AGEVH(AGEVF,5,AGEVHDA,"REF",AGEVADA)) Q:'AGEVADA D
.. S AGEV("DEP REF ID",AGEVHDA,AGEVADA)=$P($G(^AGEVH(AGEVF,5,AGEVHDA,"REF",AGEVADA,0)),U)
.. S $P(AGEV("DEP REF ID",AGEVHDA,AGEVADA),U,2)=$P($G(^AGEVH(AGEVF,5,AGEVHDA,"REF",AGEVADA,0)),U,2)
..Q
. S AGEVADA=0
. F S AGEVADA=$O(^AGEVH(AGEVF,5,AGEVHDA,"AAA",AGEVADA)) Q:'AGEVADA D
.. S AGEV("DEP ELG REQ VAL",AGEVHDA,AGEVADA)=$G(^AGEVH(AGEVF,5,AGEVHDA,"AAA",AGEVADA,0))
..Q
. S AGEVADA=0
. F S AGEVADA=$O(^AGEVH(AGEVF,5,AGEVHDA,"DTP",AGEVADA)) Q:'AGEVADA D
.. S AGEV("DEP ELG DTP",AGEVHDA,AGEVADA)=$P($G(^AGEVH(AGEVF,5,AGEVHDA,"DTP",AGEVADA,0)),U)
.. S $P(AGEV("DEP ELG DTP",AGEVHDA,AGEVADA),U,2)=$P($G(^AGEVH(AGEVF,5,AGEVHDA,"DTP",AGEVADA,0)),U,2)
..Q
. S AGEVADA=0
. F S AGEVADA=$O(^AGEVH(AGEVF,5,AGEVHDA,"MSG",AGEVADA)) Q:'AGEVADA D
.. S AGEV("DEP ELG MSG",AGEVHDA,AGEVADA)=$G(^AGEVH(AGEVF,5,AGEVHDA,"MSG",AGEVADA,0))
..Q
.Q
Q
;
TEXT ;
;;AGEV Eligibility Verification
;;
;;******************************
;;* Verify Patient Eligibility *
;;******************************
;;
Q
;
HELP ; -- help code
S X="?"
D DISP^XQORM1
W !!
Q
;
EXIT ; -- exit code
D EN^XBVK("AGEV")
K ^TMP("AGEV",$J)
K AGEVRCNT,AGEVLINE,AGEVX,AGEVP0,AGEVC,AGEVL,AGEVLR,AGEVPIEN,AGEVAF
K AGEVPRB,AGEVOVRR,AGEVLOOK,AGEVPDFN,AGEVLOC,AGEVDATE
K X,Y
K VALMHDR
Q
;
EXPND ; -- expand code
Q
AGEVLM ; cmi/flag/maw - AGEV Insurance Eligibility Verification ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
MAIN ;-- main routine driver
+1 IF $DATA(IOF)
WRITE @IOF
+2 FOR J=1:1:5
SET X=$PIECE($TEXT(TEXT+J),";;",2)
WRITE !?80-$LENGTH(X)\2,X
+3 KILL X,J
+4 WRITE !!
+5 SET AGEVPLPT=""
+6 FOR
DO GETPAT
IF AGEVPLPT=""
QUIT
SET DFN=AGEVPLPT
DO EN1
DO FULL^VALM1
DO EXIT
KILL AGEVPLPT
+7 DO EOJ
+8 QUIT
+9 ;
GETPAT ;-- get patient
+1 KILL AGEVPLPT,AGEVLOC,AGEVPAT,AGEVDATE,AGEVPIEN,AGEVAF,AGEVPRB,AGEVOVRR
+2 KILL AGEVLOOK,AGEVPDFN
+3 DO KILL^AUPNPAT
+4 SET AGEVPLPT=""
+5 WRITE !
+6 SET DIC="^AGEVH("
SET DIC(0)="AEMQ"
+7 DO ^DIC
+8 KILL DIC
+9 IF Y<0
QUIT
+10 SET AGEVF=+Y
SET AGEVPLPT=$PIECE(Y,U,2)
+11 QUIT
+12 ;
EOJ ;-- end of job cleanup
+1 ;clears out all list man stuff
IF $DATA(VALMWD)
DO CLEAR^VALM1
+2 KILL XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF
+3 KILL VALMMCON,VALMDN,VALMEVL,VALMIOXY,VALMKEY,VALMLFT,VALMLST,VALMMENU
+4 KILL VALMSGR,VALMUP,VALMWD,VALMY,XQORS,XQORSPEW
+5 KILL AGEVPLPT,AGEVLOC,AGEVPAT,AGEVDATE,AGEVPIEN,AGEVAF,AGEVPRB,AGEVOVRR
+6 KILL AGEVLOOK,AGEVPDFN
+7 DO KILL^AUPNPAT
DO EN^XBVK("BHLX")
DO EN^XBVK("AGEV")
+8 QUIT
+9 ;
EN1 ;PEP - requires DFN to be set to patient
+1 IF '$GET(DFN)
QUIT
+2 SET AGEVPLPT=DFN
+3 IF '$GET(AGEVPLPT)
QUIT
+4 IF '$DATA(^AUPNPAT(AGEVPLPT))
QUIT
+5 IF '$DATA(^DPT(AGEVPLPT))
QUIT
+6 SET Y=AGEVPLPT
+7 DO ^AUPNPAT
DO EN
+8 KILL AGEVPLPT
+9 DO FULL^VALM1
DO EXIT
+10 QUIT
+11 ;
EN ;PEP - main entry point for AGEV ELIGIBILITY VERIFICATION
+1 ;1 means screen mode, 0 means scrolling mode
SET VALMCC=1
+2 DO EN^VALM("AGEV ELIGIBILITY VERIFICATION")
DO CLEAR^VALM1
+3 QUIT
+4 ;
HDR ;EP - header code
+1 SET VALMHDR(1)=$TRANSLATE($JUSTIFY(" ",80)," ","-")
+2 SET VALMHDR(2)="Name: "_IORVON_$EXTRACT($PIECE(^DPT(AGEVPLPT,0),U),1,30)_IOINORM
+3 SET VALMHDR(2)=VALMHDR(2)_" DOB: "_$$FTIME^VALM1(AUPNDOB)_" Sex: "
+4 SET VALMHDR(2)=VALMHDR(2)_$PIECE(^DPT(AGEVPLPT,0),U,2)_" HRN: "
+5 SET VALMHDR(2)=VALMHDR(2)_$SELECT($DATA(^AUPNPAT(AGEVPLPT,41,DUZ(2),0)):$PIECE(^AUPNPAT(AGEVPLPT,41,DUZ(2),0),U,2),1:"????")
+6 SET VALMHDR(3)=$TRANSLATE($JUSTIFY(" ",80)," ","-")
+7 QUIT
+8 ;
INIT ;-- init variables and list array
+1 DO GATHER
+2 ;this variable must be the total number of line
SET VALMCNT=AGEVLINE
+3 QUIT
+4 ;
GATHER ;EP - this gets the particular patient
+1 ;set up array containing insurances for the patient
+2 ;**** see page 7 of List Manager Manual for info on how to
+3 ;**** set up the array that contains the list
+4 KILL AGEVQUIT,AGEVPL
+5 SET (AGEVCNT,AGEVRCNT,AGEVLINE)=0
+6 IF '$ORDER(^AGEVH("B",AGEVPLPT,0))
Begin DoDot:1
+7 SET ^TMP("AGEV",$JOB,1,0)="No insurance entries currently on file"
+8 SET ^TMP("AGEV",$JOB,"IDX",1,1)=""
+9 SET AGEVRCNT=1
+10 QUIT
End DoDot:1
QUIT
+11 SET AGEVAF="A"
+12 DO GATHER1
+13 QUIT
+14 ;
GATHER1 ;-- this gets the patient and policy holder information
+1 IF '$GET(^AGEVH(AGEVF,0))
QUIT
+2 SET AGEVH0=$GET(^AGEVH(AGEVF,0))
SET AGEVH1=$GET(^AGEVH(AGEVF,1))
+3 IF AGEVH1=""
QUIT
+4 SET AGEVINS=$PIECE(AGEVH0,U,2)
+5 IF AGEVINS=""
QUIT
+6 SET AGEVPOLH=$PIECE(AGEVH1,U)
+7 SET AGEVPOLN=$PIECE(AGEVH1,U,3)
+8 SET AGEVPOLG=$PIECE(AGEVH1,U,4)
+9 SET AGEVPHSX=$PIECE(AGEVH1,U,5)
+10 SET AGEVPST=$PIECE(AGEVH1,U,8)
+11 SET AGEVPDOB=$$FMTE^XLFDT($PIECE(AGEVH1,U,10))
+12 DO SUB
DO DEP
+13 IF $$GET1^DIQ(9999999.18,AGEVINS,.01)["MEDICAID"
DO MCD^AGEVLM0
QUIT
+14 IF $$GET1^DIQ(9999999.18,AGEVINS,.01)["MEDICARE"
DO MCR^AGEVLM0
QUIT
+15 IF $$GET1^DIQ(9999999.18,AGEVINS,.01)["RAILROAD"
DO RR^AGEVLM0
QUIT
+16 DO PI^AGEVLM0
+17 QUIT
+18 ;
SUB ;-- this gets the subscriber information
+1 SET AGEVHDA=0
+2 FOR
SET AGEVHDA=$ORDER(^AGEVH(AGEVF,2,AGEVHDA))
IF 'AGEVHDA
QUIT
Begin DoDot:1
+3 SET AGEV("SUB REQ VAL",AGEVHDA)=$GET(^AGEVH(AGEVF,2,AGEVHDA,0))
+4 QUIT
End DoDot:1
+5 SET AGEVHDA=0
+6 FOR
SET AGEVHDA=$ORDER(^AGEVH(AGEVF,2.5,AGEVHDA))
IF 'AGEVHDA
QUIT
Begin DoDot:1
+7 SET AGEV("SUB DTP",AGEVHDA)=$PIECE($GET(^AGEVH(AGEVF,2.5,AGEVHDA,0)),U)
+8 SET $PIECE(AGEV("SUB DTP",AGEVHDA),U,2)=$PIECE($GET(^AGEVH(AGEVF,2.5,AGEVHDA,0)),U,2)
+9 QUIT
End DoDot:1
+10 SET AGEVHDA=0
+11 FOR
SET AGEVHDA=$ORDER(^AGEVH(AGEVF,3,AGEVHDA))
IF 'AGEVHDA
QUIT
Begin DoDot:1
+12 SET AGEV("SUB ELG INFO",AGEVHDA)=$PIECE($GET(^AGEVH(AGEVF,3,AGEVHDA,0)),U)
+13 SET $PIECE(AGEV("SUB ELG INFO",AGEVHDA),U,2)=$PIECE($GET(^AGEVH(AGEVF,3,AGEVHDA,0)),U,2)
+14 SET $PIECE(AGEV("SUB ELG INFO",AGEVHDA),U,3)=$PIECE($GET(^AGEVH(AGEVF,3,AGEVHDA,0)),U,3)
+15 SET AGEVADA=0
+16 FOR
SET AGEVADA=$ORDER(^AGEVH(AGEVF,3,AGEVHDA,"REF",AGEVADA))
IF 'AGEVADA
QUIT
Begin DoDot:2
+17 SET AGEV("SUB REF ID",AGEVHDA,AGEVADA)=$PIECE($GET(^AGEVH(AGEVF,3,AGEVHDA,"REF",AGEVADA,0)),U)
+18 SET $PIECE(AGEV("SUB REF ID",AGEVHDA,AGEVADA),U,2)=$PIECE($GET(^AGEVH(AGEVF,3,AGEVHDA,"REF",AGEVADA,0)),U,2)
+19 QUIT
End DoDot:2
+20 SET AGEVADA=0
+21 FOR
SET AGEVADA=$ORDER(^AGEVH(AGEVF,3,AGEVHDA,"AAA",AGEVADA))
IF 'AGEVADA
QUIT
Begin DoDot:2
+22 SET AGEV("SUB ELG REQ VAL",AGEVHDA,AGEVADA)=$GET(^AGEVH(AGEVF,3,AGEVHDA,"AAA",AGEVADA,0))
+23 QUIT
End DoDot:2
+24 SET AGEVADA=0
+25 FOR
SET AGEVADA=$ORDER(^AGEVH(AGEVF,3,AGEVHDA,"DTP",AGEVADA))
IF 'AGEVADA
QUIT
Begin DoDot:2
+26 SET AGEV("SUB ELG DTP",AGEVHDA,AGEVADA)=$PIECE($GET(^AGEVH(AGEVF,3,AGEVHDA,"DTP",AGEVADA,0)),U)
+27 SET $PIECE(AGEV("SUB ELG DTP",AGEVHDA,AGEVADA),U,2)=$PIECE($GET(^AGEVH(AGEVF,3,AGEVHDA,"DTP",AGEVADA,0)),U,2)
+28 QUIT
End DoDot:2
+29 SET AGEVADA=0
+30 FOR
SET AGEVADA=$ORDER(^AGEVH(AGEVF,3,AGEVHDA,"MSG",AGEVADA))
IF 'AGEVADA
QUIT
Begin DoDot:2
+31 SET AGEV("SUB ELG MSG",AGEVHDA,AGEVADA)=$GET(^AGEVH(AGEVF,3,AGEVHDA,"MSG",AGEVADA,0))
+32 QUIT
End DoDot:2
+33 QUIT
End DoDot:1
+34 QUIT
+35 ;
DEP ;-- this gets the dependent information
+1 SET AGEVHDA=0
+2 FOR
SET AGEVHDA=$ORDER(^AGEVH(AGEVF,4,AGEVHDA))
IF 'AGEVHDA
QUIT
Begin DoDot:1
+3 SET AGEV("DEP REQ VAL",AGEVHDA)=$GET(^AGEVH(AGEVF,4,AGEVHDA,0))
+4 QUIT
End DoDot:1
+5 SET AGEVHDA=0
+6 FOR
SET AGEVHDA=$ORDER(^AGEVH(AGEVF,4.5,AGEVHDA))
IF 'AGEVHDA
QUIT
Begin DoDot:1
+7 SET AGEV("DEP DTP",AGEVHDA)=$PIECE($GET(^AGEVH(AGEVF,4.5,AGEVHDA,0)),U)
+8 SET $PIECE(AGEV("DEP DTP",AGEVHDA),U,2)=$PIECE($GET(^AGEVH(AGEVF,4.5,AGEVHDA,0)),U,2)
End DoDot:1
+9 SET AGEVHDA=0
FOR
SET AGEVHDA=$ORDER(^AGEVH(AGEVF,5,AGEVHDA))
IF 'AGEVHDA
QUIT
Begin DoDot:1
+10 SET AGEV("DEP ELG INFO",AGEVHDA)=$PIECE($GET(^AGEVH(AGEVF,5,AGEVHDA,0)),U)
+11 SET $PIECE(AGEV("DEP ELG INFO",AGEVHDA),U,2)=$PIECE($GET(^AGEVH(AGEVF,5,AGEVHDA,0)),U,2)
+12 SET $PIECE(AGEV("DEP ELG INFO",AGEVHDA),U,3)=$PIECE($GET(^AGEVH(AGEVF,5,AGEVHDA,0)),U,3)
+13 SET AGEVADA=0
+14 FOR
SET AGEVADA=$ORDER(^AGEVH(AGEVF,5,AGEVHDA,"REF",AGEVADA))
IF 'AGEVADA
QUIT
Begin DoDot:2
+15 SET AGEV("DEP REF ID",AGEVHDA,AGEVADA)=$PIECE($GET(^AGEVH(AGEVF,5,AGEVHDA,"REF",AGEVADA,0)),U)
+16 SET $PIECE(AGEV("DEP REF ID",AGEVHDA,AGEVADA),U,2)=$PIECE($GET(^AGEVH(AGEVF,5,AGEVHDA,"REF",AGEVADA,0)),U,2)
+17 QUIT
End DoDot:2
+18 SET AGEVADA=0
+19 FOR
SET AGEVADA=$ORDER(^AGEVH(AGEVF,5,AGEVHDA,"AAA",AGEVADA))
IF 'AGEVADA
QUIT
Begin DoDot:2
+20 SET AGEV("DEP ELG REQ VAL",AGEVHDA,AGEVADA)=$GET(^AGEVH(AGEVF,5,AGEVHDA,"AAA",AGEVADA,0))
+21 QUIT
End DoDot:2
+22 SET AGEVADA=0
+23 FOR
SET AGEVADA=$ORDER(^AGEVH(AGEVF,5,AGEVHDA,"DTP",AGEVADA))
IF 'AGEVADA
QUIT
Begin DoDot:2
+24 SET AGEV("DEP ELG DTP",AGEVHDA,AGEVADA)=$PIECE($GET(^AGEVH(AGEVF,5,AGEVHDA,"DTP",AGEVADA,0)),U)
+25 SET $PIECE(AGEV("DEP ELG DTP",AGEVHDA,AGEVADA),U,2)=$PIECE($GET(^AGEVH(AGEVF,5,AGEVHDA,"DTP",AGEVADA,0)),U,2)
+26 QUIT
End DoDot:2
+27 SET AGEVADA=0
+28 FOR
SET AGEVADA=$ORDER(^AGEVH(AGEVF,5,AGEVHDA,"MSG",AGEVADA))
IF 'AGEVADA
QUIT
Begin DoDot:2
+29 SET AGEV("DEP ELG MSG",AGEVHDA,AGEVADA)=$GET(^AGEVH(AGEVF,5,AGEVHDA,"MSG",AGEVADA,0))
+30 QUIT
End DoDot:2
+31 QUIT
End DoDot:1
+32 QUIT
+33 ;
TEXT ;
+1 ;;AGEV Eligibility Verification
+2 ;;
+3 ;;******************************
+4 ;;* Verify Patient Eligibility *
+5 ;;******************************
+6 ;;
+7 QUIT
+8 ;
HELP ; -- help code
+1 SET X="?"
+2 DO DISP^XQORM1
+3 WRITE !!
+4 QUIT
+5 ;
EXIT ; -- exit code
+1 DO EN^XBVK("AGEV")
+2 KILL ^TMP("AGEV",$JOB)
+3 KILL AGEVRCNT,AGEVLINE,AGEVX,AGEVP0,AGEVC,AGEVL,AGEVLR,AGEVPIEN,AGEVAF
+4 KILL AGEVPRB,AGEVOVRR,AGEVLOOK,AGEVPDFN,AGEVLOC,AGEVDATE
+5 KILL X,Y
+6 KILL VALMHDR
+7 QUIT
+8 ;
EXPND ; -- expand code
+1 QUIT
