Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IVMLDEM2

IVMLDEM2.m

Go to the documentation of this file.
  1. IVMLDEM2 ;ALB/KCL - IVM DEMOGRAPHIC UPLOADABLE FIELDS ; 15-APR-94
  1. ;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ;
  1. EN ; - main entry point for IVM DEMOGRAPHIC UPLOADABLE
  1. N IVMENT
  1. D EN^VALM("IVM DEMOGRAPHIC UPLOADABLE")
  1. Q
  1. ;
  1. ;
  1. HDR ; - header code for list manager display
  1. S IVMBLNK="",$P(IVMBLNK," ",45)=""
  1. ;
  1. ; - list manager header line 1
  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"
  1. ;
  1. ; - list manager header line 2
  1. S VALMHDR(2)=" "
  1. Q
  1. ;
  1. ;
  1. INIT ; - init variables and list array
  1. ;
  1. ; Input: IVMDA2 -- Pointer to case record in file #301.5
  1. ; IVMDA1 -- Pointer to PID msg in sub-file #301.501
  1. ; DFN -- Pointer to patient in file #2
  1. ;
  1. ;
  1. ; - flag used for delete demographic field action (DF)
  1. S IVMWHERE="UP"
  1. ;
  1. K ^TMP("IVMUPLOAD",$J)
  1. S IVMBL="",$P(IVMBL," ",35)="",IVMCNTR=0
  1. D DEM^VADPT,ADD^VADPT S IVMSTATE="",IVMSTPTR=$P(VAPA(5),"^")
  1. F IVMDA=0:0 S IVMDA=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA)) Q:'IVMDA D
  1. .;
  1. .; - grab node with IVM-supplied data
  1. .S IVMDEMO=$G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA,0)) I IVMDEMO="" Q
  1. .;
  1. .; - quit if data element is non-uploadable
  1. .S IVMTABLE=$G(^IVM(301.92,+$P(IVMDEMO,"^"),0))
  1. .Q:'$P(IVMTABLE,"^",3)
  1. .;
  1. .; - grab the IVM-supplied state
  1. .I $P(IVMTABLE,"^",2)["PID114" S IVMSTATE=$P(IVMDEMO,"^",2)
  1. .;
  1. .S IVMCNTR=IVMCNTR+1
  1. .;
  1. .; - extract DHCP value in displayable format
  1. .S IVMDHCP="" X:$D(^IVM(301.92,+$P(IVMDEMO,"^"),2)) ^(2) S IVMDHCP=Y
  1. .;
  1. .; - build index record to use for processing as
  1. .; ^tmp("ivmupload",$j,"idx",ctr,ctr)=dfn^da(2)^da(1)^da^ivm data^pointer to file (#1)^dhcp field number^dhcp field name
  1. .;
  1. .S ^TMP("IVMUPLOAD",$J,"IDX",IVMCNTR,IVMCNTR)=DFN_"^"_IVMDA2_"^"_IVMDA1_"^"_IVMDA_"^"_$P(IVMDEMO,"^",2)_"^"_$P(IVMTABLE,"^",4)_"^"_$P(IVMTABLE,"^",5)_"^"_$P(IVMTABLE,"^")
  1. .;
  1. .; - build list manager display line
  1. .D WRITLINE($P(IVMTABLE,"^")_"^"_IVMDHCP_"^"_$P(IVMDEMO,"^",2),IVMCNTR)
  1. ;
  1. ;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
  1. ;
  1. ;
  1. I '$O(@VALMAR@(0)) D
  1. .;
  1. .; - check for non-uploadable fields, if no fields do DELETE
  1. .I '$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,0) D DELETE^IVMLDEM5(IVMDA2,IVMDA1,IVMNAME)
  1. .;
  1. .; - if non-uploadable fields set array field from 'YES' to 'NO' for list manager display
  1. .I $$DEMO^IVMLDEM5(IVMDA2,IVMDA1,0) S $P(^TMP("IVMDUPL",$J,IVMNAME,IVMDA2,IVMDA1),"^",4)="NO"
  1. .;
  1. .; - display msg to user that no uploadable data to view
  1. .S @VALMAR@(1,0)=" "
  1. .S @VALMAR@(2,0)="There is no uploadable demographic information to view."
  1. .S IVMCNTR=2
  1. ;
  1. ; - list manager variable as number of lines in the list
  1. S VALMCNT=IVMCNTR
  1. ;
  1. INITQ ; - clean up variables
  1. D KVA^VADPT ; kill all variables defined by VADPT routine
  1. K IVMBL,IVMBLNK,IVMCNTR,IVMDA,IVMDEMO,IVMDHCP,IVMFIELD,IVMSTATE,IVMSTPTR,IVMTABLE
  1. Q
  1. ;
  1. ;
  1. WRITLINE(IVMLINE,IVMNUM) ; - write line out for list manager display
  1. ;
  1. ; Input: IVMLINE -- as the line for display:
  1. ; dhcp field name^dhcp field value^ivm field value
  1. ; IVMNUM -- as the line number
  1. ; Output: None
  1. ;
  1. N IVMLN,IVMOUT1,IVMOUT2
  1. S IVMOUT1=$P(IVMLINE,"^",2)
  1. I $P(IVMTABLE,"^",7) S IVMOUT1=$$OUTTR^IVMUFNC(IVMOUT1,IVMTABLE,IVMSTPTR)
  1. S:IVMOUT1="" IVMOUT1="(* NONE ON FILE *)"
  1. S IVMOUT2=$$OUTTR^IVMUFNC($P(IVMLINE,"^",3),IVMTABLE,IVMSTATE)
  1. S IVMLN=$E($P(IVMLINE,"^",1)_IVMBL,1,30)_" "_$E(IVMOUT1_IVMBL,1,20)_" "_$E(IVMOUT2_IVMBL,1,20)
  1. D CNTRL^VALM10(IVMNUM,58,22,IOINHI,IOINORM) ; highlight IVM field value
  1. S @VALMAR@(IVMNUM,0)=$E(IVMNUM_" ",1,3)_IVMLN
  1. Q
  1. ;
  1. ;
  1. HELP ; - help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; - exit code
  1. K ^TMP("IVMUPLOAD",$J)
  1. Q