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