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

DGRP1152U.m

Go to the documentation of this file.
  1. DGRP1152U ;ALB/LEG - REGISTRATION SCREEN 11.5.2 (UTILS)/VERIFICATION INFORMATION ;JUN 08, 2020@23:00
  1. ;;5.3;Registration;**1014**;AUG 13, 1993;Build 42
  1. ;=======================================================================================
  1. ; EXTRA PROCESSING FUNCTIONS
  1. Q
  1. ;
  1. TMP(DGTMP) ; constructs DGTMP data from Patient CCP data
  1. N DGFIDX,DGEFFDT,DGREC
  1. D CLEAN^VALM10
  1. ; DGTMP is NEWd in DGRPU1152A
  1. K DGTMP
  1. M DGTMP(DFN,5)=^DPT(DFN,5)
  1. S DGFIDX=0
  1. F S DGFIDX=$O(DGTMP(DFN,5,DGFIDX)) Q:'DGFIDX S DGREC=$G(DGTMP(DFN,5,DGFIDX,0)) D
  1. . S DGEFFDT=$P(DGREC,U,3)
  1. . S DGTMP("EFDT",DGEFFDT,DGFIDX)=DGREC
  1. D GETCCP
  1. Q
  1. ;
  1. GETCCP ; collects all CCP recs; sorts decreasing by EFFDT
  1. N DGBLANKS,DGEFFDT,DGEFFDTO,DGENDT,DGFIDX,DGLINE,DGLINECNT,DGREC,DGRECNO,DGCCPCD,DGRECCCP
  1. N DGRECCCPCD,DGRECCCPNM,DGRECEFDT,DGRECEFDTO,DGRECODT,DGLINEVAR
  1. S VALMCNT=0,DGLINECNT=0,DGLINE=0,DGBLANKS="",$P(DGBLANKS," ",40)=""
  1. ;
  1. ; BY EFFDT --- DGTMP("EFDT",EFFDT,DGFIDX)=DGREC sort via most recent EFFECTIVE DATE in DECREASING ORDER
  1. S DGEFFDT=""
  1. F S DGEFFDT=$O(DGTMP("EFDT",DGEFFDT),-1) Q:DGEFFDT="" D
  1. . S DGFIDX="" F S DGFIDX=$O(DGTMP("EFDT",DGEFFDT,DGFIDX)) Q:DGFIDX="" D
  1. . . S DGREC=DGTMP("EFDT",DGEFFDT,DGFIDX)
  1. . . S DGENDT=$P(DGREC,U,4)
  1. . . I 'DGENDT D SETREC
  1. ;NOTE: for VALM* rtns processing, "VALMCNT" represents total lines written,
  1. S VALMCNT=VALMCNT*2 ; thus, a 2 line display==>"*2", while a 3 line display==>"*3"
  1. Q
  1. SETREC ; sets ListMan Display record
  1. ; for Phase I Line 1 data
  1. S DGLINEVAR=""
  1. S DGRECCCPCD=$P(DGREC,U,2)
  1. S DGRECCCPNM=$E($$EXTERNAL^DILFD(2.191,1,"",DGRECCCPCD)_DGBLANKS,1,30)
  1. S DGRECEFDT=$P(DGREC,U,3) S DGRECEFDTO=$$UP^XLFSTR($$FMTE^XLFDT($E(DGRECEFDT,1,12),1))
  1. ; strip the space between the day and year
  1. S DGRECODT=$P(DGRECEFDTO," ",1,2)_$P(DGRECEFDTO," ",3)
  1. S VALMCNT=VALMCNT+1
  1. S DGRECNO=$J($E("["_VALMCNT_"] ",1,5),5)
  1. S DGLINEVAR=$$SETFLD^VALM1(DGRECNO,DGLINEVAR,"NO")
  1. S DGLINEVAR=$$SETFLD^VALM1(DGRECCCPNM,DGLINEVAR,"CCPNAME")
  1. S DGLINEVAR=$$SETFLD^VALM1(DGRECODT,DGLINEVAR,"EFFDATE")
  1. S DGLINECNT=DGLINECNT+1
  1. D SET^VALM10(DGLINECNT,DGLINEVAR,VALMCNT)
  1. S DGLINECNT=DGLINECNT+1
  1. S DGLINEVAR="" ; for Phase II Line 2 data space holder
  1. D SET^VALM10(DGLINECNT,DGLINEVAR)
  1. S DGTMP("IDX",VALMCNT,DGFIDX)=DGREC
  1. Q
  1. ;
  1. ARCHALL(DFN) ; ARCHIVE CCP entries
  1. ; Called from KILL logic of Xref in .361 (PRIMARY ELIGIBILITY) field
  1. ; and .01 (ELIGIBILITY CODE) field of the PATIENT ELIGIBILITIES subfile
  1. ; when the COLLATERAL OF VET eligibility code is deleted
  1. ; Also invoked from Z11 logic when ES is removing the COV eligibility
  1. ; For CCPs not already archived:
  1. ; - Active CCPs are end dated
  1. ; - Achive field set
  1. ;
  1. N DGCCP,DGFDA,DGERR,X,Y
  1. S DGCCP=0 F S DGCCP=$O(^DPT(DFN,5,DGCCP)) Q:'DGCCP I $G(^(DGCCP,0))'="" D
  1. . ; Quit if ARCHIVE flag already set
  1. . I $$GET1^DIQ(2.191,DGCCP_","_DFN_",",4,"I")=1 Q
  1. . ; Set the End Date if not already set
  1. . I $$GET1^DIQ(2.191,DGCCP_","_DFN_",",3)="" D SAVENDT^DGRP1152A(DGCCP)
  1. . ; Set the ARCHIVE field to "1"
  1. . S DGFDA(2.191,DGCCP_","_DFN_",",4)=1
  1. . ; CCP LAST UPDATED DATE
  1. . S DGFDA(2.191,DGCCP_","_DFN_",",.01)=$$NOW^XLFDT()
  1. . D FILE^DIE("","DGFDA","DGERR")
  1. Q
  1. ;
  1. MULTERR ; Invoked from ^DGRP1152A when adding/editing the Effective Date for a CCP
  1. D EN^DDIOL("Effective Date for this CCP entry must be unique. The Effective Date entered is the same date as a previous entry for a particular CCP.")
  1. ;
  1. Q
  1. REMOVE(DFN) ; Invoked from ECDS^DGLOCK1 (Input Transform logic for Primary Eligibility field .361)
  1. ; This is called when COLLATERAL OF VET is being replaced
  1. ; - Remove all CCPs to a temp global and remove them from the Patient record.
  1. ; New X and Y so input transform vars are not overwritten
  1. K ^TMP("DGCCP",$J,DFN)
  1. N DIK,DA,Y,X
  1. S ^TMP("DGCCP",$J,DFN)=""
  1. Q:'$D(^DPT(DFN,5))
  1. ; Move everything out and ^DIK the CCPs from the patient file
  1. M ^TMP("DGCCP",$J,DFN,5)=^DPT(DFN,5)
  1. S DA(1)=DFN
  1. S DIK="^DPT("_DFN_",5,"
  1. S DA=0 F S DA=$O(^DPT(DFN,5,DA)) Q:'DA D
  1. .D ^DIK
  1. S ^DPT(DFN,5,0)=""
  1. Q
  1. ;
  1. RESTORE(DFN) ; Invoked from "AEL" Cross-reference, Set logic, of Primary Eligibility field .361
  1. ; - If the ^TMP("DGCCP",$J,DFN) global (see REMOVE tag) does not exist, then quit.
  1. ; - Otherwise, move the CCPs in ^TMP back into the patient record.
  1. ; and if COV is no longer in .361 field, add it into the PATIENT ELIGIBILIITIES subfile .0361
  1. ; The result is that COV is moved from PRIMARY to the subfile and the CCPs are intact
  1. ; (COV cannnot be deleted if there are active CCPs but it can be replaced with another eligibility and moved to the subfile.)
  1. ; NEW X and Y so xref vars aren't overwritten
  1. N DGZ,Y,X,DGERR,DGIENS,DGFDA,DGDATA,DGFDAIEN,DGNEWIEN
  1. I '$D(^TMP("DGCCP",$J,DFN)) Q
  1. S DGZ=0 F S DGZ=$O(^TMP("DGCCP",$J,DFN,5,DGZ)) Q:'DGZ D
  1. . S DGERR=0
  1. . S DGIENS=DFN_","
  1. . S DGIENS="+1,"_DGIENS
  1. . S DGFDA(2.191,DGIENS,.01)=$P(^TMP("DGCCP",$J,DFN,5,DGZ,0),"^",1)
  1. . S DGFDA(2.191,DGIENS,1)=$P(^TMP("DGCCP",$J,DFN,5,DGZ,0),"^",2)
  1. . S DGFDA(2.191,DGIENS,2)=$P(^TMP("DGCCP",$J,DFN,5,DGZ,0),"^",3)
  1. . S DGFDA(2.191,DGIENS,3)=$P(^TMP("DGCCP",$J,DFN,5,DGZ,0),"^",4)
  1. . S DGFDA(2.191,DGIENS,4)=$P(^TMP("DGCCP",$J,DFN,5,DGZ,0),"^",5)
  1. . D UPDATE^DIE("","DGFDA","","DGERR")
  1. . K DGFDA
  1. K ^TMP("DGCCP",$J,DFN)
  1. ; If COV is still in .361, nothing changed, quit
  1. I $$GET1^DIQ(2,DFN_",",.361,"E")="COLLATERAL OF VET." Q
  1. ;
  1. ; Otherwise, COV has been replaced with another eligibility - restore COV into the Eligibilities subfile .0361
  1. N DGDATA,DGFDAIEN,DGNEWIEN
  1. S DGNEWIEN="+1,"_DFN_","
  1. S DGDATA(2.0361,DGNEWIEN,.01)=$$FIND1^DIC(8,"","B","COLLATERAL")
  1. S DGFDAIEN(1)=$$FIND1^DIC(8,"","B","COLLATERAL")
  1. D UPDATE^DIE("","DGDATA","DGFDAIEN","DGERR")
  1. Q