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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMLDEM 3803 printed Oct 16, 2024@18:02:24 Page 2
IVMLDEM ;ALB/KCL - IVM DEMOGRAPHIC UPLOAD PATIENT DISPLAY ; 11-APR-94
+1 ;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;
EN ; - main entry point
+1 NEW IVMENT
+2 DO BUILD
+3 ; if no patients with demographic info - quit
IF IVMCTR=0
GOTO EXIT
+4 DO EN^VALM("IVM DEMOGRAPHIC")
+5 QUIT
+6 ;
+7 ;
BUILD ; - build an array of IVM patients with demographic data for uploading
+1 KILL ^TMP("IVMDUPL",$JOB)
+2 WRITE !,"Building patient list for display..."
+3 SET IVMCTR=0
+4 ;
+5 ; - get patients with demographic fields from ASEG x-ref
+6 SET IVMI=0
FOR
SET IVMI=$ORDER(^IVM(301.5,"ASEG","PID",IVMI))
if 'IVMI
QUIT
Begin DoDot:1
+7 SET IVMJ=0
FOR
SET IVMJ=$ORDER(^IVM(301.5,"ASEG","PID",IVMI,IVMJ))
if 'IVMJ
QUIT
Begin DoDot:2
+8 SET IVMCTR=IVMCTR+1
if '(IVMCTR#15)
WRITE "."
+9 ;
+10 ; - grab node from file #301.5
+11 SET IVM0NODE=$GET(^IVM(301.5,IVMI,0))
IF IVM0NODE']""
QUIT
+12 ;
+13 ; - get DFN and grab node from file #2
+14 SET DFN=+IVM0NODE
SET IVM0DPT=$GET(^DPT(+DFN,0))
IF IVM0DPT']""
QUIT
+15 ;
+16 ; - patient name and ssn
+17 SET IVMNAME=$PIECE(IVM0DPT,"^")
SET IVMSSN=$PIECE(IVM0DPT,"^",9)
SET IVMSSN=$EXTRACT(IVMSSN,1,3)_"-"_$EXTRACT(IVMSSN,4,5)_"-"_$EXTRACT(IVMSSN,6,9)
+18 ;
+19 ; - check for uploadable and non-uploadable fields
+20 SET IVMUP=$SELECT($$DEMO^IVMLDEM5(IVMI,IVMJ,1)=1:"YES",1:"NO")
+21 SET IVMINFO=$SELECT($$DEMO^IVMLDEM5(IVMI,IVMJ,0)=1:"YES",1:"NO")
+22 ;
+23 ; - build line for list manager display
+24 DO BUILDLN
End DoDot:2
End DoDot:1
+25 ;
+26 IF IVMCTR=0
WRITE !!,"There is no IVM demographic information to be uploaded at this time.",!,*7
+27 ;
BUILDQ ; - clean up variables
+1 KILL DFN,IVM0NODE,IVM0DPT,IVMCHK,IVMI,IVMINFO,IVMJ,IVMNAME,IVMSSN,IVMUP
+2 QUIT
+3 ;
+4 ;
BUILDLN ; - build storage array with data for List Manager (called from BLD)
+1 ;
+2 SET ^TMP("IVMDUPL",$JOB,IVMNAME,IVMI,IVMJ)=DFN_"^"_IVMNAME_"^"_IVMSSN_"^"_IVMUP_"^"_IVMINFO
+3 ;
+4 ; ^tmp("ivmdupl",$j,pat name, ivm ien, ivm sub ien)=dfn^patient name^patient ssn^demo uploadable^demo info only
+5 QUIT
+6 ;
+7 ;
HDR ; - header code for list manager display
+1 ; header line 1
SET VALMHDR(1)="Patient Demographic Information"
+2 ; header line 2
SET VALMHDR(2)=" Uploadable Non-uploadable"
+3 QUIT
+4 ;
+5 ;
INIT ; - init variables and list array
+1 KILL ^TMP("IVMLST",$JOB)
+2 SET IVMBL=""
SET $PIECE(IVMBL," ",30)=""
SET IVMCTR=0
+3 SET IVMNAME=""
FOR
SET IVMNAME=$ORDER(^TMP("IVMDUPL",$JOB,IVMNAME))
if IVMNAME']""
QUIT
SET IVMI=""
Begin DoDot:1
+4 FOR
SET IVMI=$ORDER(^TMP("IVMDUPL",$JOB,IVMNAME,IVMI))
if 'IVMI
QUIT
SET IVMJ=""
Begin DoDot:2
+5 FOR
SET IVMJ=$ORDER(^TMP("IVMDUPL",$JOB,IVMNAME,IVMI,IVMJ))
if 'IVMJ
QUIT
Begin DoDot:3
+6 ;
+7 ; - IVMLN as the line for the list manager display
+8 SET IVMLN=$GET(^TMP("IVMDUPL",$JOB,IVMNAME,IVMI,IVMJ))
IF IVMLN']""
QUIT
+9 ;
+10 ; - increment counter and write line
+11 SET IVMCTR=IVMCTR+1
DO WRLN(IVMLN,IVMCTR)
+12 ;
+13 ; - build index record to use for processing as
+14 ; ^tmp("ivmlst",$j,"idx",ctr,ctr)=dfn^pat name^ien (#301.5) file^ien (#301.501) sub file
+15 SET ^TMP("IVMLST",$JOB,"IDX",IVMCTR,IVMCTR)=$PIECE(IVMLN,"^",1)_"^"_IVMNAME_"^"_IVMI_"^"_IVMJ
End DoDot:3
End DoDot:2
End DoDot:1
+16 ;
+17 ; - list manager variable as number of lines in the list
+18 SET VALMCNT=IVMCTR
+19 ;
INITQ ; - clean up variables
+1 KILL DFN,IVMBL,IVMCTR,IVMI,IVMJ,IVMLINE,IVMLN,IVMNAME,IVMNUM
+2 QUIT
+3 ;
+4 ;
WRLN(IVMLINE,IVMNUM) ; - write line out for list manager display
+1 ;
+2 ; Input: IVMLINE -- as line for display
+3 ; dfn^pat name^pat ssn^uploadable (yes/no)^non-uploadable (yes/no)
+4 ; IVMNUM -- as the line number
+5 ; Output: None
+6 ;
+7 NEW IVMLN
+8 SET IVMLN=$EXTRACT($PIECE(IVMLINE,"^",2)_IVMBL,1,30)_" "_$EXTRACT($PIECE(IVMLINE,"^",3)_IVMBL,1,15)_" "_$EXTRACT($PIECE(IVMLINE,"^",4)_IVMBL,1,13)_" "_$PIECE(IVMLINE,"^",5)
+9 ; highlight
IF $PIECE(IVMLINE,"^",4)["YES"
DO CNTRL^VALM10(IVMNUM,55,3,IOINHI,IOINORM)
+10 SET @VALMAR@(IVMNUM,0)=$EXTRACT(IVMNUM_" ",1,5)_IVMLN
+11 QUIT
+12 ;
+13 ;
HELP ; - help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
+4 ;
EXIT ; - exit code
+1 KILL ^TMP("IVMLST",$JOB),^TMP("IVMDUPL",$JOB)
+2 QUIT
