108 lines
3.6 KiB
Mathematica
108 lines
3.6 KiB
Mathematica
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
|