- 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
