- 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 Jan 18, 2025@03:56:13 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