source: FOIAVistA/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMLDEM.m@ 1397

IVMLDEM ;ALB/KCL - IVM DEMOGRAPHIC UPLOAD PATIENT DISPLAY ; 11-APR-94
 ;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
 ;
EN ; - main entry point
 N IVMENT
 D BUILD
 I IVMCTR=0 G EXIT ; if no patients with demographic info - quit
 D EN^VALM("IVM DEMOGRAPHIC")
 Q
 ;
 ;
BUILD ; - build an array of IVM patients with demographic data for uploading
 K ^TMP("IVMDUPL",$J)
 W !,"Building patient list for display..."
 S IVMCTR=0
 ;
 ; - get patients with demographic fields from ASEG x-ref
 S IVMI=0 F  S IVMI=$O(^IVM(301.5,"ASEG","PID",IVMI)) Q:'IVMI  D
 .S IVMJ=0 F  S IVMJ=$O(^IVM(301.5,"ASEG","PID",IVMI,IVMJ)) Q:'IVMJ  D
 ..S IVMCTR=IVMCTR+1 W:'(IVMCTR#15) "."
 ..;
 ..; - grab node from file #301.5
 ..S IVM0NODE=$G(^IVM(301.5,IVMI,0)) I IVM0NODE']"" Q
 ..;
 ..; - get DFN and grab node from file #2
 ..S DFN=+IVM0NODE,IVM0DPT=$G(^DPT(+DFN,0)) I IVM0DPT']"" Q
 ..;
 ..; - patient name and ssn
 ..S IVMNAME=$P(IVM0DPT,"^"),IVMSSN=$P(IVM0DPT,"^",9),IVMSSN=$E(IVMSSN,1,3)_"-"_$E(IVMSSN,4,5)_"-"_$E(IVMSSN,6,9)
 ..;
 ..; - check for uploadable and non-uploadable fields
 ..S IVMUP=$S($$DEMO^IVMLDEM5(IVMI,IVMJ,1)=1:"YES",1:"NO")
 ..S IVMINFO=$S($$DEMO^IVMLDEM5(IVMI,IVMJ,0)=1:"YES",1:"NO")
 ..;
 ..; - build line for list manager display
 ..D BUILDLN
 ;
 I IVMCTR=0 W !!,"There is no IVM demographic information to be uploaded at this time.",!,*7
 ;
BUILDQ ; - clean up variables
 K DFN,IVM0NODE,IVM0DPT,IVMCHK,IVMI,IVMINFO,IVMJ,IVMNAME,IVMSSN,IVMUP
 Q
 ;
 ;
BUILDLN ; - build storage array with data for List Manager (called from BLD)
 ;
 S ^TMP("IVMDUPL",$J,IVMNAME,IVMI,IVMJ)=DFN_"^"_IVMNAME_"^"_IVMSSN_"^"_IVMUP_"^"_IVMINFO
 ;
 ; ^tmp("ivmdupl",$j,pat name, ivm ien, ivm sub ien)=dfn^patient name^patient ssn^demo uploadable^demo info only
 Q
 ;
 ;
HDR ; -  header code for list manager display
 S VALMHDR(1)="Patient Demographic Information" ; header line 1
 S VALMHDR(2)="                                                   Uploadable     Non-uploadable" ; header line 2
 Q
 ;
 ;
INIT ; - init variables and list array
 K ^TMP("IVMLST",$J)
 S IVMBL="",$P(IVMBL," ",30)="",IVMCTR=0
 S IVMNAME="" F  S IVMNAME=$O(^TMP("IVMDUPL",$J,IVMNAME)) Q:IVMNAME']""  S IVMI="" D
 .F  S IVMI=$O(^TMP("IVMDUPL",$J,IVMNAME,IVMI)) Q:'IVMI  S IVMJ="" D
 ..F  S IVMJ=$O(^TMP("IVMDUPL",$J,IVMNAME,IVMI,IVMJ)) Q:'IVMJ  D
 ...;
 ...; - IVMLN as the line for the list manager display
 ...S IVMLN=$G(^TMP("IVMDUPL",$J,IVMNAME,IVMI,IVMJ)) I IVMLN']"" Q
 ...;
 ...; - increment counter and write line
 ...S IVMCTR=IVMCTR+1 D WRLN(IVMLN,IVMCTR)
 ...;
 ...; - build index record to use for processing as
 ...; ^tmp("ivmlst",$j,"idx",ctr,ctr)=dfn^pat name^ien (#301.5) file^ien (#301.501) sub file
 ...S ^TMP("IVMLST",$J,"IDX",IVMCTR,IVMCTR)=$P(IVMLN,"^",1)_"^"_IVMNAME_"^"_IVMI_"^"_IVMJ
 ;
 ; - list manager variable as number of lines in the list
 S VALMCNT=IVMCTR
 ;
INITQ ; - clean up variables
 K DFN,IVMBL,IVMCTR,IVMI,IVMJ,IVMLINE,IVMLN,IVMNAME,IVMNUM
 Q
 ;
 ;
WRLN(IVMLINE,IVMNUM) ; - write line out for list manager display
 ;
 ;  Input:  IVMLINE  --  as line for display
 ;                       dfn^pat name^pat ssn^uploadable (yes/no)^non-uploadable (yes/no)
 ;           IVMNUM  --  as the line number
 ; Output:  None
 ;
 N IVMLN
 S IVMLN=$E($P(IVMLINE,"^",2)_IVMBL,1,30)_"  "_$E($P(IVMLINE,"^",3)_IVMBL,1,15)_"  "_$E($P(IVMLINE,"^",4)_IVMBL,1,13)_"  "_$P(IVMLINE,"^",5)
 I $P(IVMLINE,"^",4)["YES" D CNTRL^VALM10(IVMNUM,55,3,IOINHI,IOINORM) ; highlight
 S @VALMAR@(IVMNUM,0)=$E(IVMNUM_"     ",1,5)_IVMLN
 Q
 ;
 ;
HELP ; - help code
 S X="?" D DISP^XQORM1 W !!
 Q
 ;
 ;
EXIT ; - exit code
 K ^TMP("IVMLST",$J),^TMP("IVMDUPL",$J)
 Q