IVMLDEM3.m

IVMLDEM3 ;ALB/KCL,JAM - IVM DEMOGRAPHIC NON-UPLOADABLE FIELDS ;15-APR-94

 ;;2.0;INCOME VERIFICATION MATCH;**5,193**;21-OCT-94;Build 37

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

 ;

EN ; - main entry point for IVM DEMOGRAPHIC NON-UPLOADABLE

 D EN^VALM("IVM DEMOGRAPHIC NON-UPLOADABLE")

 Q

 ;

 ;

HDR ; - header code for list manager display

 S IVMBLNK="",$P(IVMBLNK," ",45)=""

 ;

 ; - header line 1

 S VALMHDR(1)="Patient: "_$E($E($P(^DPT(DFN,0),"^"),1,20)_" "_"("_$E($P(^DPT(DFN,0),"^",9),6,9)_")"_IVMBLNK,1,35)_" "_"Non-uploadable Demographic Fields"

 ;

 ; - header line 2

 S VALMHDR(2)=" "

 Q

 ;

 ;

INIT ; - init variables and list array

 ;

 ;  Input:  IVMDA2  --  Pointer to case record in file #301.5

 ;          IVMDA1  --  Pointer to PID msg in sub-file #301.501

 ;             DFN  --  Pointer to patient in file #2

 ;

 ;

 ; - flag used for delete demographic field action (DF)

 S IVMWHERE="NON"

 S IVMSTAT2=""

 K ^TMP("IVMNONUP",$J)

 S IVMBL="",$P(IVMBL," ",58)="",IVMCNTR=0,IVM27=0

 D DEM^VADPT,ADD^VADPT S IVMSTATE=$P(VAPA(5),"^")

 F IVMDA=0:0 S IVMDA=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA)) Q:'IVMDA  D

 .;

 .; - grab node with IVM-supplied data

 .S IVMDEMO=$G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA,0)) I IVMDEMO="" Q

 .;

 .; - quit if data element is uploadable

 .S IVMTABLE=$G(^IVM(301.92,+$P(IVMDEMO,"^"),0))

 .Q:$P(IVMTABLE,"^",3)=1

 .;

 .; - if ivm state data then set IVMSTAT2 for decoding county code

 .I $P(IVMTABLE,"^")["STATE" S IVMSTAT2=$P(IVMDEMO,"^",2)

 .;

 .S IVMCNTR=IVMCNTR+1

 .;

 .; - primary eligibility code

 .S:$P(IVMDEMO,"^")=27 IVM27=IVM27+1

 .;

 .; - extract DHCP value in displayable format

 .; Patch IVM*2.0*193; JAM; If Y is not defined, quit

 .S IVMDHCP="" X:$D(^IVM(301.92,$P(IVMDEMO,"^"),2)) ^(2) Q:$G(Y)=""  S IVMDHCP=Y

 .;

 .; - build index record to use for processing as

 .;   ctr is line # and ctr1 is entry #

 .;    ^tmp("ivmnonup",$j,"idx",ctr,ctr1)=dfn^da(2)^da(1)^da^ivm data^pointer to file (#1)^dhcp field number^dhcp field name

 .;

 .S IVMCNTR1=$S(IVM27<2:IVMCNTR,1:IVMCNTR-IVM27+1)

 .S ^TMP("IVMNONUP",$J,"IDX",IVMCNTR,IVMCNTR1)=DFN_"^"_IVMDA2_"^"_IVMDA1_"^"_IVMDA_"^"_$P(IVMDEMO,"^",2)_"^"_$P(IVMTABLE,"^",4)_"^"_$P(IVMTABLE,"^",5)_"^"_$P(IVMTABLE,"^")

 .;

 .; - build list manager display line

 .D WRITLINE($P(IVMTABLE,"^")_"^"_IVMDHCP_"^"_$P(IVMDEMO,"^",2),IVMCNTR)

 ;

 ;

 I '$O(@VALMAR@(0)) D

 .;

 .; - check for uploadable fields, if no fields do DELETE

 .I '$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,1) D DELETE^IVMLDEM5(IVMDA2,IVMDA1,IVMNAME)

 .;

 .; - if uploadable fields set array field from 'YES' to 'NO' for list manager display

 .I $$DEMO^IVMLDEM5(IVMDA2,IVMDA1,1) S $P(^TMP("IVMDUPL",$J,IVMNAME,IVMDA2,IVMDA1),"^",5)="NO"

 .;

 .; - display msg to user that no uploadable data to view

 .D KILL^VALM10(1)

 .D KILL^VALM10(2)

 .S @VALMAR@(1,0)=" "

 .S @VALMAR@(2,0)="There is no non-uploadable demographic information to view."

 .S IVMCNTR=2

 ;

 ; - list manager variable as number of lines in the list

 S VALMCNT=IVMCNTR

 ;

 ;

INITQ ; - clean up variables

 D KVA^VADPT ; kill all variables defined by VADPT routine

 K IVMBL,IVMBLNK,IVMCNTR,IVMCNTR1,IVMDA,IVMDEMO,IVMDHCP,IVMFIELD

 K IVMSTAT2,IVMSTATE,IVMTABLE,IVM27

 Q

 ;

 ;

WRITLINE(IVMLINE,IVMNUM) ; - write line out for list manager display

 ;

 ;  Input:  IVMLINE  --  as the line for display:

 ;                       dhcp field name^dhcp field value^ivm field value

 ;           IVMNUM  --  as the line number

 ; Output:  None

 ;

 N IVMLN,IVMOUT1,IVMOUT2,IVMNUM1

 S IVMOUT1=$P(IVMLINE,"^",2)

 I $P(IVMTABLE,"^",7) S IVMOUT1=$$OUTTR^IVMUFNC(IVMOUT1,IVMTABLE,IVMSTATE)

 S:IVMOUT1="" IVMOUT1="(* NONE ON FILE *)"

 S IVMOUT2=$$OUTTR^IVMUFNC($P(IVMLINE,"^",3),IVMTABLE,IVMSTAT2)

 S IVMLN=$E($P(IVMLINE,"^",1)_IVMBL,1,30)_"  "_$E(IVMOUT1_IVMBL,1,20)_"  "_$E(IVMOUT2_IVMBL,1,20)

 ;

 ; - highlight IVM field value

 D CNTRL^VALM10(IVMNUM,58,22,IOINHI,IOINORM)

 I $P(IVMDEMO,"^")=27,IVM27>1 S @VALMAR@(IVMNUM,0)=IVMBL_$E(IVMOUT2_IVMBL,1,20) Q

 S IVMNUM1=$S(IVM27>1:IVMNUM-IVM27+1,1:IVMNUM)

 S @VALMAR@(IVMNUM,0)=$E(IVMNUM1_"   ",1,3)_IVMLN

 Q

 ;

 ;

HELP ; - help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; - exit code

 K ^TMP("IVMNONUP",$J)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IVMLDEM3   4304     printed  Feb 18, 2025@23:27:19                                                                                                                                                                                                    Page 2

IVMLDEM3  ;ALB/KCL,JAM - IVM DEMOGRAPHIC NON-UPLOADABLE FIELDS ;15-APR-94

 +1       ;;2.0;INCOME VERIFICATION MATCH;**5,193**;21-OCT-94;Build 37

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

 +4       ;

EN        ; - main entry point for IVM DEMOGRAPHIC NON-UPLOADABLE

 +1        DO EN^VALM("IVM DEMOGRAPHIC NON-UPLOADABLE")

 +2        QUIT 

 +3       ;

 +4       ;

HDR       ; - header code for list manager display

 +1        SET IVMBLNK=""

           SET $PIECE(IVMBLNK," ",45)=""

 +2       ;

 +3       ; - header line 1

 +4        SET VALMHDR(1)="Patient: "_$EXTRACT($EXTRACT($PIECE(^DPT(DFN,0),"^"),1,20)_" "_"("_$EXTRACT($PIECE(^DPT(DFN,0),"^",9),6,9)_")"_IVMBLNK,1,35)_" "_"Non-uploadable Demographic Fields"

 +5       ;

 +6       ; - header line 2

 +7        SET VALMHDR(2)=" "

 +8        QUIT 

 +9       ;

 +10      ;

INIT      ; - init variables and list array

 +1       ;

 +2       ;  Input:  IVMDA2  --  Pointer to case record in file #301.5

 +3       ;          IVMDA1  --  Pointer to PID msg in sub-file #301.501

 +4       ;             DFN  --  Pointer to patient in file #2

 +5       ;

 +6       ;

 +7       ; - flag used for delete demographic field action (DF)

 +8        SET IVMWHERE="NON"

 +9        SET IVMSTAT2=""

 +10       KILL ^TMP("IVMNONUP",$JOB)

 +11       SET IVMBL=""

           SET $PIECE(IVMBL," ",58)=""

           SET IVMCNTR=0

           SET IVM27=0

 +12       DO DEM^VADPT

           DO ADD^VADPT

           SET IVMSTATE=$PIECE(VAPA(5),"^")

 +13       FOR IVMDA=0:0

               SET IVMDA=$ORDER(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA))

               if 'IVMDA

                   QUIT 

               Begin DoDot:1

 +14      ;

 +15      ; - grab node with IVM-supplied data

 +16               SET IVMDEMO=$GET(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA,0))

                   IF IVMDEMO=""

                       QUIT 

 +17      ;

 +18      ; - quit if data element is uploadable

 +19               SET IVMTABLE=$GET(^IVM(301.92,+$PIECE(IVMDEMO,"^"),0))

 +20               if $PIECE(IVMTABLE,"^",3)=1

                       QUIT 

 +21      ;

 +22      ; - if ivm state data then set IVMSTAT2 for decoding county code

 +23               IF $PIECE(IVMTABLE,"^")["STATE"

                       SET IVMSTAT2=$PIECE(IVMDEMO,"^",2)

 +24      ;

 +25               SET IVMCNTR=IVMCNTR+1

 +26      ;

 +27      ; - primary eligibility code

 +28               if $PIECE(IVMDEMO,"^")=27

                       SET IVM27=IVM27+1

 +29      ;

 +30      ; - extract DHCP value in displayable format

 +31      ; Patch IVM*2.0*193; JAM; If Y is not defined, quit

 +32               SET IVMDHCP=""

                   if $DATA(^IVM(301.92,$PIECE(IVMDEMO,"^"),2))

                       XECUTE ^(2)

                   if $GET(Y)=""

                       QUIT 

                   SET IVMDHCP=Y

 +33      ;

 +34      ; - build index record to use for processing as

 +35      ;   ctr is line # and ctr1 is entry #

 +36      ;    ^tmp("ivmnonup",$j,"idx",ctr,ctr1)=dfn^da(2)^da(1)^da^ivm data^pointer to file (#1)^dhcp field number^dhcp field name

 +37      ;

 +38               SET IVMCNTR1=$SELECT(IVM27<2:IVMCNTR,1:IVMCNTR-IVM27+1)

 +39               SET ^TMP("IVMNONUP",$JOB,"IDX",IVMCNTR,IVMCNTR1)=DFN_"^"_IVMDA2_"^"_IVMDA1_"^"_IVMDA_"^"_$PIECE(IVMDEMO,"^",2)_"^"_$PIECE(IVMTABLE,"^",4)_"^"_$PIECE(IVMTABLE,"^",5)_"^"_$PIECE(IVMTABLE,"^")

 +40      ;

 +41      ; - build list manager display line

 +42               DO WRITLINE($PIECE(IVMTABLE,"^")_"^"_IVMDHCP_"^"_$PIECE(IVMDEMO,"^",2),IVMCNTR)

               End DoDot:1

 +43      ;

 +44      ;

 +45       IF '$ORDER(@VALMAR@(0))

               Begin DoDot:1

 +46      ;

 +47      ; - check for uploadable fields, if no fields do DELETE

 +48               IF '$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,1)

                       DO DELETE^IVMLDEM5(IVMDA2,IVMDA1,IVMNAME)

 +49      ;

 +50      ; - if uploadable fields set array field from 'YES' to 'NO' for list manager display

 +51               IF $$DEMO^IVMLDEM5(IVMDA2,IVMDA1,1)

                       SET $PIECE(^TMP("IVMDUPL",$JOB,IVMNAME,IVMDA2,IVMDA1),"^",5)="NO"

 +52      ;

 +53      ; - display msg to user that no uploadable data to view

 +54               DO KILL^VALM10(1)

 +55               DO KILL^VALM10(2)

 +56               SET @VALMAR@(1,0)=" "

 +57               SET @VALMAR@(2,0)="There is no non-uploadable demographic information to view."

 +58               SET IVMCNTR=2

               End DoDot:1

 +59      ;

 +60      ; - list manager variable as number of lines in the list

 +61       SET VALMCNT=IVMCNTR

 +62      ;

 +63      ;

INITQ     ; - clean up variables

 +1       ; kill all variables defined by VADPT routine

           DO KVA^VADPT

 +2        KILL IVMBL,IVMBLNK,IVMCNTR,IVMCNTR1,IVMDA,IVMDEMO,IVMDHCP,IVMFIELD

 +3        KILL IVMSTAT2,IVMSTATE,IVMTABLE,IVM27

 +4        QUIT 

 +5       ;

 +6       ;

WRITLINE(IVMLINE,IVMNUM) ; - write line out for list manager display

 +1       ;

 +2       ;  Input:  IVMLINE  --  as the line for display:

 +3       ;                       dhcp field name^dhcp field value^ivm field value

 +4       ;           IVMNUM  --  as the line number

 +5       ; Output:  None

 +6       ;

 +7        NEW IVMLN,IVMOUT1,IVMOUT2,IVMNUM1

 +8        SET IVMOUT1=$PIECE(IVMLINE,"^",2)

 +9        IF $PIECE(IVMTABLE,"^",7)

               SET IVMOUT1=$$OUTTR^IVMUFNC(IVMOUT1,IVMTABLE,IVMSTATE)

 +10       if IVMOUT1=""

               SET IVMOUT1="(* NONE ON FILE *)"

 +11       SET IVMOUT2=$$OUTTR^IVMUFNC($PIECE(IVMLINE,"^",3),IVMTABLE,IVMSTAT2)

 +12       SET IVMLN=$EXTRACT($PIECE(IVMLINE,"^",1)_IVMBL,1,30)_"  "_$EXTRACT(IVMOUT1_IVMBL,1,20)_"  "_$EXTRACT(IVMOUT2_IVMBL,1,20)

 +13      ;

 +14      ; - highlight IVM field value

 +15       DO CNTRL^VALM10(IVMNUM,58,22,IOINHI,IOINORM)

 +16       IF $PIECE(IVMDEMO,"^")=27

               IF IVM27>1

                   SET @VALMAR@(IVMNUM,0)=IVMBL_$EXTRACT(IVMOUT2_IVMBL,1,20)

                   QUIT 

 +17       SET IVMNUM1=$SELECT(IVM27>1:IVMNUM-IVM27+1,1:IVMNUM)

 +18       SET @VALMAR@(IVMNUM,0)=$EXTRACT(IVMNUM1_"   ",1,3)_IVMLN

 +19       QUIT 

 +20      ;

 +21      ;

HELP      ; - help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; - exit code

 +1        KILL ^TMP("IVMNONUP",$JOB)

 +2        QUIT