Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AGEVLM1

AGEVLM1.m

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