- 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