- IVMLDEM2 ;ALB/KCL - IVM DEMOGRAPHIC UPLOADABLE FIELDS ; 15-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 for IVM DEMOGRAPHIC UPLOADABLE
- N IVMENT
- D EN^VALM("IVM DEMOGRAPHIC UPLOADABLE")
- Q
- ;
- ;
- HDR ; - header code for list manager display
- S IVMBLNK="",$P(IVMBLNK," ",45)=""
- ;
- ; - list manager 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,39)_" "_"Uploadable Demographic Fields"
- ;
- ; - list manager 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="UP"
- ;
- K ^TMP("IVMUPLOAD",$J)
- S IVMBL="",$P(IVMBL," ",35)="",IVMCNTR=0
- D DEM^VADPT,ADD^VADPT S IVMSTATE="",IVMSTPTR=$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 non-uploadable
- .S IVMTABLE=$G(^IVM(301.92,+$P(IVMDEMO,"^"),0))
- .Q:'$P(IVMTABLE,"^",3)
- .;
- .; - grab the IVM-supplied state
- .I $P(IVMTABLE,"^",2)["PID114" S IVMSTATE=$P(IVMDEMO,"^",2)
- .;
- .S IVMCNTR=IVMCNTR+1
- .;
- .; - extract DHCP value in displayable format
- .S IVMDHCP="" X:$D(^IVM(301.92,+$P(IVMDEMO,"^"),2)) ^(2) S IVMDHCP=Y
- .;
- .; - build index record to use for processing as
- .; ^tmp("ivmupload",$j,"idx",ctr,ctr)=dfn^da(2)^da(1)^da^ivm data^pointer to file (#1)^dhcp field number^dhcp field name
- .;
- .S ^TMP("IVMUPLOAD",$J,"IDX",IVMCNTR,IVMCNTR)=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)) S @VALMAR@(1,0)=" ",@VALMAR@(2,0)="There is no uploadable demographic information to view.",IVMCNTR=2,^TMP("IVMUPLOAD",$J,"IDX",1,1)=1,^TMP("IVMUPLOAD",$J,"IDX",2,2)=2
- ;
- ;
- I '$O(@VALMAR@(0)) D
- .;
- .; - check for non-uploadable fields, if no fields do DELETE
- .I '$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,0) D DELETE^IVMLDEM5(IVMDA2,IVMDA1,IVMNAME)
- .;
- .; - if non-uploadable fields set array field from 'YES' to 'NO' for list manager display
- .I $$DEMO^IVMLDEM5(IVMDA2,IVMDA1,0) S $P(^TMP("IVMDUPL",$J,IVMNAME,IVMDA2,IVMDA1),"^",4)="NO"
- .;
- .; - display msg to user that no uploadable data to view
- .S @VALMAR@(1,0)=" "
- .S @VALMAR@(2,0)="There is no 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,IVMDA,IVMDEMO,IVMDHCP,IVMFIELD,IVMSTATE,IVMSTPTR,IVMTABLE
- 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
- S IVMOUT1=$P(IVMLINE,"^",2)
- I $P(IVMTABLE,"^",7) S IVMOUT1=$$OUTTR^IVMUFNC(IVMOUT1,IVMTABLE,IVMSTPTR)
- S:IVMOUT1="" IVMOUT1="(* NONE ON FILE *)"
- S IVMOUT2=$$OUTTR^IVMUFNC($P(IVMLINE,"^",3),IVMTABLE,IVMSTATE)
- S IVMLN=$E($P(IVMLINE,"^",1)_IVMBL,1,30)_" "_$E(IVMOUT1_IVMBL,1,20)_" "_$E(IVMOUT2_IVMBL,1,20)
- D CNTRL^VALM10(IVMNUM,58,22,IOINHI,IOINORM) ; highlight IVM field value
- S @VALMAR@(IVMNUM,0)=$E(IVMNUM_" ",1,3)_IVMLN
- Q
- ;
- ;
- HELP ; - help code
- S X="?" D DISP^XQORM1 W !!
- Q
- ;
- EXIT ; - exit code
- K ^TMP("IVMUPLOAD",$J)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMLDEM2 4036 printed Feb 18, 2025@23:27:18 Page 2
- IVMLDEM2 ;ALB/KCL - IVM DEMOGRAPHIC UPLOADABLE FIELDS ; 15-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 for IVM DEMOGRAPHIC UPLOADABLE
- +1 NEW IVMENT
- +2 DO EN^VALM("IVM DEMOGRAPHIC UPLOADABLE")
- +3 QUIT
- +4 ;
- +5 ;
- HDR ; - header code for list manager display
- +1 SET IVMBLNK=""
- SET $PIECE(IVMBLNK," ",45)=""
- +2 ;
- +3 ; - list manager 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,39)_" "_"Uploadable Demographic Fields"
- +5 ;
- +6 ; - list manager 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="UP"
- +9 ;
- +10 KILL ^TMP("IVMUPLOAD",$JOB)
- +11 SET IVMBL=""
- SET $PIECE(IVMBL," ",35)=""
- SET IVMCNTR=0
- +12 DO DEM^VADPT
- DO ADD^VADPT
- SET IVMSTATE=""
- SET IVMSTPTR=$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 non-uploadable
- +19 SET IVMTABLE=$GET(^IVM(301.92,+$PIECE(IVMDEMO,"^"),0))
- +20 if '$PIECE(IVMTABLE,"^",3)
- QUIT
- +21 ;
- +22 ; - grab the IVM-supplied state
- +23 IF $PIECE(IVMTABLE,"^",2)["PID114"
- SET IVMSTATE=$PIECE(IVMDEMO,"^",2)
- +24 ;
- +25 SET IVMCNTR=IVMCNTR+1
- +26 ;
- +27 ; - extract DHCP value in displayable format
- +28 SET IVMDHCP=""
- if $DATA(^IVM(301.92,+$PIECE(IVMDEMO,"^"),2))
- XECUTE ^(2)
- SET IVMDHCP=Y
- +29 ;
- +30 ; - build index record to use for processing as
- +31 ; ^tmp("ivmupload",$j,"idx",ctr,ctr)=dfn^da(2)^da(1)^da^ivm data^pointer to file (#1)^dhcp field number^dhcp field name
- +32 ;
- +33 SET ^TMP("IVMUPLOAD",$JOB,"IDX",IVMCNTR,IVMCNTR)=DFN_"^"_IVMDA2_"^"_IVMDA1_"^"_IVMDA_"^"_$PIECE(IVMDEMO,"^",2)_"^"_$PIECE(IVMTABLE,"^",4)_"^"_$PIECE(IVMTABLE,"^",5)_"^"_$PIECE(IVMTABLE,"^")
- +34 ;
- +35 ; - build list manager display line
- +36 DO WRITLINE($PIECE(IVMTABLE,"^")_"^"_IVMDHCP_"^"_$PIECE(IVMDEMO,"^",2),IVMCNTR)
- End DoDot:1
- +37 ;
- +38 ;I '$O(@VALMAR@(0)) S @VALMAR@(1,0)=" ",@VALMAR@(2,0)="There is no uploadable demographic information to view.",IVMCNTR=2,^TMP("IVMUPLOAD",$J,"IDX",1,1)=1,^TMP("IVMUPLOAD",$J,"IDX",2,2)=2
- +39 ;
- +40 ;
- +41 IF '$ORDER(@VALMAR@(0))
- Begin DoDot:1
- +42 ;
- +43 ; - check for non-uploadable fields, if no fields do DELETE
- +44 IF '$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,0)
- DO DELETE^IVMLDEM5(IVMDA2,IVMDA1,IVMNAME)
- +45 ;
- +46 ; - if non-uploadable fields set array field from 'YES' to 'NO' for list manager display
- +47 IF $$DEMO^IVMLDEM5(IVMDA2,IVMDA1,0)
- SET $PIECE(^TMP("IVMDUPL",$JOB,IVMNAME,IVMDA2,IVMDA1),"^",4)="NO"
- +48 ;
- +49 ; - display msg to user that no uploadable data to view
- +50 SET @VALMAR@(1,0)=" "
- +51 SET @VALMAR@(2,0)="There is no uploadable demographic information to view."
- +52 SET IVMCNTR=2
- End DoDot:1
- +53 ;
- +54 ; - list manager variable as number of lines in the list
- +55 SET VALMCNT=IVMCNTR
- +56 ;
- INITQ ; - clean up variables
- +1 ; kill all variables defined by VADPT routine
- DO KVA^VADPT
- +2 KILL IVMBL,IVMBLNK,IVMCNTR,IVMDA,IVMDEMO,IVMDHCP,IVMFIELD,IVMSTATE,IVMSTPTR,IVMTABLE
- +3 QUIT
- +4 ;
- +5 ;
- 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
- +8 SET IVMOUT1=$PIECE(IVMLINE,"^",2)
- +9 IF $PIECE(IVMTABLE,"^",7)
- SET IVMOUT1=$$OUTTR^IVMUFNC(IVMOUT1,IVMTABLE,IVMSTPTR)
- +10 if IVMOUT1=""
- SET IVMOUT1="(* NONE ON FILE *)"
- +11 SET IVMOUT2=$$OUTTR^IVMUFNC($PIECE(IVMLINE,"^",3),IVMTABLE,IVMSTATE)
- +12 SET IVMLN=$EXTRACT($PIECE(IVMLINE,"^",1)_IVMBL,1,30)_" "_$EXTRACT(IVMOUT1_IVMBL,1,20)_" "_$EXTRACT(IVMOUT2_IVMBL,1,20)
- +13 ; highlight IVM field value
- DO CNTRL^VALM10(IVMNUM,58,22,IOINHI,IOINORM)
- +14 SET @VALMAR@(IVMNUM,0)=$EXTRACT(IVMNUM_" ",1,3)_IVMLN
- +15 QUIT
- +16 ;
- +17 ;
- HELP ; - help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
- +3 ;
- EXIT ; - exit code
- +1 KILL ^TMP("IVMUPLOAD",$JOB)
- +2 QUIT