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

DGRP11B.m

Go to the documentation of this file.
  1. DGRP11B ;ALB/JAM,ARF - REGISTRATION SCREEN 11.5.1/VERIFICATION INFORMATION ;Mar 09, 2020@12:34
  1. ;;5.3;Registration;**997,1014**;AUG 13, 1993;Build 42
  1. ;IA's:
  1. ; GETDFN^MPIF001 - Supported #2701 ;retrieves DFN from ICN via MPI
  1. ;
  1. EN(DFN) ;Main entry point to invoke the DGEN CGP DETAIL list
  1. ; Input -- DFN Patient IEN
  1. ;
  1. D WAIT^DICD
  1. D EN^VALM("DGEN CGP DETAIL")
  1. Q
  1. ;
  1. HDR ;Header code
  1. N X
  1. D LISTHDR^DGRPU(1) ;DG*5.3*1014 - ARF - sets patient data in the 1st and 2nd entries in VALMHDR array
  1. ;D PID^VADPT ;DG*5.3*1014 begin - comment previous code
  1. ;S VALMHDR(1)=$E("Patient: "_$P($G(^DPT(DFN,0)),U),1,30)
  1. ;S VALMHDR(1)=VALMHDR(1)_" ("_VA("BID")_")"
  1. ;S X="PATIENT TYPE UNKNOWN"
  1. ;I $D(^DPT(DFN,"TYPE")),$D(^DG(391,+^("TYPE"),0)) S X=$P(^(0),U,1)
  1. ;S VALMHDR(1)=$$SETSTR^VALM1(X,VALMHDR(1),60,80) ;DG*5.3*1014 end - comment previous code
  1. Q
  1. ;
  1. INIT ;Build patient Caregiver screen
  1. D CLEAN^VALM10
  1. D CLEAR^VALM1
  1. D GETCGP
  1. Q
  1. ;
  1. GETCGP ;Load Caregiver data from MPI array into TMP(VALMAR global for display
  1. N DGCGRET,DGCGTCNT,DGCG,DGCGG1,DGCGICN,DGSSN,DGCGRELTYP,DGCGSUBTYP,DGCGSTATUS,DGX,DGY,DGCGSTATDT,DGCGCNT,DGCGDISPDT
  1. N LINEVAR,DGDFN,DGFNAME,DGLNAME,DGNAME
  1. ; Call MPI interface to get patient relationship array
  1. D GET^VAFCREL(.DGCGRET,DFN)
  1. ; Get array of Cargivers (DGCG) from the MPI Relationship array
  1. D MPIGETCG^DGRP11A(.DGCGRET,.DGCG,.DGCGTCNT)
  1. S VALMCNT=0,DGCGCNT=0
  1. ; Format of DGCG array:
  1. ; ICN^RELTYP^RELTYPDISP^RCODE^RSTATUS^RSTATUSDISP^RSTATDATE^CGSPONSNAM"
  1. ; eg: DGCG(1)="1002345678V123456^CGP^CAREGIVER: PRIMARY^QUAL^ACTIVE^APPROVED^20200220^Jones, William M"
  1. S LINEVAR="CAREGIVER"
  1. F S DGCGCNT=$O(DGCG(DGCGCNT)) Q:DGCGCNT="" D
  1. . S DGCGG1=DGCG(DGCGCNT)
  1. . S VALMCNT=VALMCNT+1
  1. . S LINEVAR=$$SETFLD^VALM1("<"_VALMCNT_">",LINEVAR,"NO")
  1. . S DGNAME=$P(DGCGG1,U,8)
  1. . S DGNAME=$$UPPER^DGUTL(DGNAME)
  1. . ;Remove extra space between Last and First names
  1. . S DGLNAME=$P(DGNAME,","),DGFNAME=$P(DGNAME,",",2),DGFNAME=$S($E(DGFNAME)=" ":$E(DGFNAME,2,99),1:DGFNAME)
  1. . S LINEVAR=$$SETFLD^VALM1(" "_$E(DGLNAME_","_DGFNAME,1,30),LINEVAR,"NAME")
  1. . ;ICN-->DFN-->SSN
  1. . S DGCGICN=$P(DGCGG1,U,1)
  1. . S DGDFN=$$GETDFN^MPIF001(DGCGICN)
  1. . S DGX=$S($D(^DPT(+DGDFN,0)):^(0),1:"")
  1. . S DGSSN=$P(DGX,"^",9)
  1. . ; Grab chars 6-10 of SSN in case of Pseudo SSN
  1. . S LINEVAR=$$SETFLD^VALM1($E(DGSSN,6,10),LINEVAR,"L4SSN")
  1. . S DGCGRELTYP=$P(DGCGG1,U,2)
  1. . S DGCGRELTYP=$$UPPER^DGUTL(DGCGRELTYP)
  1. . S DGCGSUBTYP=$S(DGCGRELTYP="CGP":"PRIMARY",DGCGRELTYP="CGS":"SECONDARY",DGCGRELTYP="CGG":"GENERAL",1:"??")
  1. . S LINEVAR=$$SETFLD^VALM1(DGCGSUBTYP,LINEVAR,"SUBTYPE")
  1. . S DGCGSTATUS=$P(DGCGG1,U,5)
  1. . S DGCGSTATUS=$$UPPER^DGUTL(DGCGSTATUS)
  1. . ; Pending-> In Process, Decline -> Denied, Inactive->Revoked, Active->Approved, Terminated->Benefit End
  1. . S DGCGSTATUS=$S(DGCGSTATUS="PENDING":"IN PROCESS",DGCGSTATUS="DECLINE":"DENIED",DGCGSTATUS="INACTIVE":"REVOKED",DGCGSTATUS="ACTIVE":"APPROVED",DGCGSTATUS="TERMINATED":"BENEFIT END",1:DGCGSTATUS)
  1. . S LINEVAR=$$SETFLD^VALM1($E(DGCGSTATUS,1,13),LINEVAR,"STATUS")
  1. . S DGX=$P(DGCGG1,U,7),DGY=$E(DGX,5,6)_"/"_$E(DGX,7,8)_"/"_$E(DGX,1,4) D DT^DILF("E",DGY,.DGCGSTATDT)
  1. . ; strip the space between the day and year
  1. . S DGCGDISPDT=$P(DGCGSTATDT(0)," ",1,2)_$P(DGCGSTATDT(0)," ",3)
  1. . S LINEVAR=$$SETFLD^VALM1(DGCGDISPDT,LINEVAR,"DATE")
  1. . D SET^VALM10(VALMCNT,LINEVAR,VALMCNT)
  1. Q
  1. ;
  1. HELP ;Help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ;Exit code
  1. D CLEAN^VALM10
  1. D CLEAR^VALM1
  1. Q