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

DGRRLU1A.m

Go to the documentation of this file.
  1. DGRRLU1A ;alb/aas,BPFO/MM DG Replacement and Rehosting RPC for VADPT (cont) - ;11/12/2003
  1. ;;5.3;Registration;**538**;Aug 13, 1993
  1. ;
  1. ;Continued from DGRRLU1
  1. ;
  1. 10 ; -- means test required, get current means test status and MAS Parameter display of notification
  1. ; if (paramater && last means test indicator == "r") display message
  1. N DGMTLST,DIVRULE,DIVTXT,DGMSGF,DGMFLG,X,DGDOM,DGDOM1
  1. S DIVRULE="false"
  1. I $P($G(^DG(40.8,+$O(^DG(40.8,"AD",+$G(DIV),0)),"MT")),"^")="Y" S DIVRULE="true"
  1. S DGMSGF=1
  1. S DGMTLST=$$CMTS^DGMTU(DFN)
  1. S DGMFLG=$$MFLG^DGMTU(DGMTLST)
  1. ;S DGMTDATE=$P($G(^DGMT(408.31,+DGMTLST,0)),U)
  1. S DIVTXT=$P($G(^DG(40.8,+$O(^DG(40.8,"AD",+$G(DIV),0)),"MT")),"^",2)
  1. S X=" <businessRule alertId='meansTestRequired' lastMeansTestDate='"_$$CHARCHK^DGRRUTL($P(DGMTLST,"^",2))
  1. S X=X_"' lastMeansTestIndicator='"_$$CHARCHK^DGRRUTL($P(DGMTLST,"^",3))_"' masDivisionRule='"_$$CHARCHK^DGRRUTL(DIVRULE)_"' text='"_$$CHARCHK^DGRRUTL(DIVTXT)
  1. S X=X_"' addTxt='"_$$CHARCHK^DGRRUTL(DGMFLG)_"'></businessRule>"
  1. DO ADD^DGRRLU(X)
  1. ;
  1. 11 ; -- legacy data for patient, check to see if patient on M data base merged into current M database
  1. ; Beginning with release 4, the legacy alert will always return false.
  1. ; Alert no longer displayed. It will be removed in a future release.
  1. DO ADD^DGRRLU(" <businessRule alertId='legacyDataExists' checkValue='"_$$CHARCHK^DGRRUTL("false")_"' facility=''></businessRule>")
  1. ;
  1. 12 ; -- fugitive felon -- to be released soon.
  1. NEW FUGITIVE
  1. SET FUGITIVE="false"
  1. IF $D(^DPT("AXFFP",1,DFN)) SET FUGITIVE="true"
  1. DO ADD^DGRRLU(" <businessRule alertId='fugitiveFelon' fugitiveStatus='"_$$CHARCHK^DGRRUTL(FUGITIVE)_"'></businessRule>")
  1. ;
  1. 13 ; -- patient record flag
  1. N DGPFFLGS,DGPFFLG,DGRRNFLG
  1. S DGRRNFLG=0
  1. S DGPFFLG=""
  1. IF +$G(PARAMS("PATIENT_RECORD_FLAG")) DO ; old version of patient record flag
  1. .I $L($T(GETACT^DGPFAPI)) S DGPFFLGS=$$GETACT^DGPFAPI(DFN,"DGPFFLGS") D
  1. .. I $G(DGPFFLGS)=0 Q
  1. .. N DGPFI
  1. .. S DGPFI=0
  1. .. F S DGPFI=$O(DGPFFLGS(DGPFI)) Q:'DGPFI D
  1. ...I DGPFI>1 S DGPFFLG=DGPFFLG_", "
  1. ...S DGPFFLG=DGPFFLG_$P($G(DGPFFLGS(+DGPFI,"FLAG")),U,2)
  1. .DO ADD^DGRRLU(" <businessRule alertId='patientRecordFlag' flag='"_$$CHARCHK^DGRRUTL(DGPFFLG)_"'></businessRule>")
  1. ;
  1. IF '+$G(PARAMS("PATIENT_RECORD_FLAG")) DO ; new (06/17/04) version of patient record flag can be turned on with this param, the flag and the old code can be removed once the new stuff is approved
  1. .I '$L($T(GETACT^DGPFAPI)) S DGRRNFLG=1 D NOALRT
  1. .Q:DGRRNFLG=1
  1. .S DGPFFLGS=$$GETACT^DGPFAPI(DFN,"DGPFFLGS") D
  1. .. I $G(DGPFFLGS)=0 D NOALRT Q
  1. .. D ADD^DGRRLU(" <businessRule alertId='patientRecordFlag'>")
  1. .. N DGPFI
  1. .. S DGPFI=0
  1. .. F S DGPFI=$O(DGPFFLGS(DGPFI)) Q:'DGPFI D
  1. ...N APPRVBY,ASSIGNDT,CATEGORY,FLAG,FLAGTYPE,ORIGSITE,OWNER,REVDT,LINE
  1. ...S APPRVBY=$$CHARCHK^DGRRUTL($P($G(DGPFFLGS(DGPFI,"APPRVBY")),U,2))
  1. ...S ASSIGNDT=$P($P($G(DGPFFLGS(DGPFI,"ASSIGNDT")),U),".")
  1. ...S FLAG=$$CHARCHK^DGRRUTL($P($G(DGPFFLGS(DGPFI,"FLAG")),U,2))
  1. ...S FLAGTYPE=$$CHARCHK^DGRRUTL($P($G(DGPFFLGS(DGPFI,"FLAGTYPE")),U,2))
  1. ...S ORIGSITE=$$CHARCHK^DGRRUTL($P($G(DGPFFLGS(DGPFI,"ORIGSITE")),U,2))
  1. ...S OWNER=$$CHARCHK^DGRRUTL($P($G(DGPFFLGS(DGPFI,"OWNER")),U,2))
  1. ...S REVDT=$P($G(DGPFFLGS(DGPFI,"REVIEWDT")),U)
  1. ...S LINE=" <flag flagNumber='"_DGPFI_"' flag='"_FLAG_"' category='"_FLAGTYPE_"' type='"_FLAGTYPE_"' assigndt='"_ASSIGNDT_"' apprvBy='"_APPRVBY_"' revDate='"_REVDT
  1. ...S LINE=LINE_"' ownerSite='"_OWNER_"' origSite='"_ORIGSITE_"'>"
  1. ...D ADD^DGRRLU(LINE)
  1. ...D ADD^DGRRLU(" <narrations>")
  1. ...N DGRRNI
  1. ...S DGRRNI=0
  1. ...F S DGRRNI=$O(DGPFFLGS(DGPFI,"NARR",DGRRNI)) Q:'DGRRNI D
  1. ....N DGRRNL
  1. ....S DGRRNL=$G(DGPFFLGS(DGPFI,"NARR",DGRRNI,0))
  1. ....D ADD^DGRRLU(" <narration>"_$$CHARCHK^DGRRUTL(DGRRNL)_"</narration>")
  1. ...D ADD^DGRRLU(" </narrations>")
  1. ...D ADD^DGRRLU(" </flag>")
  1. ..D ADD^DGRRLU(" </businessRule>")
  1. ;
  1. 14 ; -- patient merged -- not a requirement
  1. DO ADD^DGRRLU(" <businessRule alertId='mergedPatient' recordMergedTo='"_$$CHARCHK^DGRRUTL($P($G(^DPT(DFN,0)),"^",19))_"'></businessRule>")
  1. ;
  1. 15 ; -- combat vet status -- being worked on by Edna Curtain.
  1. N CVSTATUS,CVEND,DGCV
  1. SET (CVSTATUS,CVEND,DGCV)=""
  1. I $L($T(CVEDT^DGCV)) S DGCV=$$CVEDT^DGCV(+DFN)
  1. I $P(DGCV,"^")=1 D
  1. . SET CVSTATUS=$S($P(DGCV,"^",2)>DT:"ELIGIBLE",1:"EXPIRED")
  1. . SET CVEND=$P(DGCV,"^",2)
  1. DO ADD^DGRRLU(" <businessRule alertId='combatvet' status='"_$$CHARCHK^DGRRUTL($G(CVSTATUS))_"' endDate='"_$$CHARCHK^DGRRUTL($G(CVEND))_"'></businessRule>")
  1. 16 ;Bad Address Indicator
  1. N DGRRBA
  1. S DGRRBA=$$BADADR^DGUTL3(DFN)
  1. DO ADD^DGRRLU(" <businessRule alertId='badAddress' indicator='"_$$CHARCHK^DGRRUTL($G(DGRRBA))_"'></businessRule>")
  1. ;
  1. END QUIT
  1. ;
  1. NOALRT ;Returns an empty alert for Patient Record Flag
  1. D ADD^DGRRLU(" <businessRule alertId='patientRecordFlag'>")
  1. S LINE=" <flag flagNumber='' category='' type='' assigndt='' apprvBy='' revDate='' ownerSite='' origSite=''>"
  1. D ADD^DGRRLU(LINE)
  1. D ADD^DGRRLU(" <narrations></narrations>")
  1. D ADD^DGRRLU(" </flag>")
  1. D ADD^DGRRLU(" </businessRule>")
  1. Q