source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRRLU1A.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.9 KB
Line 
1DGRRLU1A ;alb/aas,BPFO/MM DG Replacement and Rehosting RPC for VADPT (cont) - ;11/12/2003
2 ;;5.3;Registration;**538**;Aug 13, 1993
3 ;
4 ;Continued from DGRRLU1
5 ;
610 ; -- means test required, get current means test status and MAS Parameter display of notification
7 ; if (paramater && last means test indicator == "r") display message
8 N DGMTLST,DIVRULE,DIVTXT,DGMSGF,DGMFLG,X,DGDOM,DGDOM1
9 S DIVRULE="false"
10 I $P($G(^DG(40.8,+$O(^DG(40.8,"AD",+$G(DIV),0)),"MT")),"^")="Y" S DIVRULE="true"
11 S DGMSGF=1
12 S DGMTLST=$$CMTS^DGMTU(DFN)
13 S DGMFLG=$$MFLG^DGMTU(DGMTLST)
14 ;S DGMTDATE=$P($G(^DGMT(408.31,+DGMTLST,0)),U)
15 S DIVTXT=$P($G(^DG(40.8,+$O(^DG(40.8,"AD",+$G(DIV),0)),"MT")),"^",2)
16 S X=" <businessRule alertId='meansTestRequired' lastMeansTestDate='"_$$CHARCHK^DGRRUTL($P(DGMTLST,"^",2))
17 S X=X_"' lastMeansTestIndicator='"_$$CHARCHK^DGRRUTL($P(DGMTLST,"^",3))_"' masDivisionRule='"_$$CHARCHK^DGRRUTL(DIVRULE)_"' text='"_$$CHARCHK^DGRRUTL(DIVTXT)
18 S X=X_"' addTxt='"_$$CHARCHK^DGRRUTL(DGMFLG)_"'></businessRule>"
19 DO ADD^DGRRLU(X)
20 ;
2111 ; -- legacy data for patient, check to see if patient on M data base merged into current M database
22 ; Beginning with release 4, the legacy alert will always return false.
23 ; Alert no longer displayed. It will be removed in a future release.
24 DO ADD^DGRRLU(" <businessRule alertId='legacyDataExists' checkValue='"_$$CHARCHK^DGRRUTL("false")_"' facility=''></businessRule>")
25 ;
2612 ; -- fugitive felon -- to be released soon.
27 NEW FUGITIVE
28 SET FUGITIVE="false"
29 IF $D(^DPT("AXFFP",1,DFN)) SET FUGITIVE="true"
30 DO ADD^DGRRLU(" <businessRule alertId='fugitiveFelon' fugitiveStatus='"_$$CHARCHK^DGRRUTL(FUGITIVE)_"'></businessRule>")
31 ;
3213 ; -- patient record flag
33 N DGPFFLGS,DGPFFLG,DGRRNFLG
34 S DGRRNFLG=0
35 S DGPFFLG=""
36 IF +$G(PARAMS("PATIENT_RECORD_FLAG")) DO ; old version of patient record flag
37 .I $L($T(GETACT^DGPFAPI)) S DGPFFLGS=$$GETACT^DGPFAPI(DFN,"DGPFFLGS") D
38 .. I $G(DGPFFLGS)=0 Q
39 .. N DGPFI
40 .. S DGPFI=0
41 .. F S DGPFI=$O(DGPFFLGS(DGPFI)) Q:'DGPFI D
42 ...I DGPFI>1 S DGPFFLG=DGPFFLG_", "
43 ...S DGPFFLG=DGPFFLG_$P($G(DGPFFLGS(+DGPFI,"FLAG")),U,2)
44 .DO ADD^DGRRLU(" <businessRule alertId='patientRecordFlag' flag='"_$$CHARCHK^DGRRUTL(DGPFFLG)_"'></businessRule>")
45 ;
46 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
47 .I '$L($T(GETACT^DGPFAPI)) S DGRRNFLG=1 D NOALRT
48 .Q:DGRRNFLG=1
49 .S DGPFFLGS=$$GETACT^DGPFAPI(DFN,"DGPFFLGS") D
50 .. I $G(DGPFFLGS)=0 D NOALRT Q
51 .. D ADD^DGRRLU(" <businessRule alertId='patientRecordFlag'>")
52 .. N DGPFI
53 .. S DGPFI=0
54 .. F S DGPFI=$O(DGPFFLGS(DGPFI)) Q:'DGPFI D
55 ...N APPRVBY,ASSIGNDT,CATEGORY,FLAG,FLAGTYPE,ORIGSITE,OWNER,REVDT,LINE
56 ...S APPRVBY=$$CHARCHK^DGRRUTL($P($G(DGPFFLGS(DGPFI,"APPRVBY")),U,2))
57 ...S ASSIGNDT=$P($P($G(DGPFFLGS(DGPFI,"ASSIGNDT")),U),".")
58 ...S FLAG=$$CHARCHK^DGRRUTL($P($G(DGPFFLGS(DGPFI,"FLAG")),U,2))
59 ...S FLAGTYPE=$$CHARCHK^DGRRUTL($P($G(DGPFFLGS(DGPFI,"FLAGTYPE")),U,2))
60 ...S ORIGSITE=$$CHARCHK^DGRRUTL($P($G(DGPFFLGS(DGPFI,"ORIGSITE")),U,2))
61 ...S OWNER=$$CHARCHK^DGRRUTL($P($G(DGPFFLGS(DGPFI,"OWNER")),U,2))
62 ...S REVDT=$P($G(DGPFFLGS(DGPFI,"REVIEWDT")),U)
63 ...S LINE=" <flag flagNumber='"_DGPFI_"' flag='"_FLAG_"' category='"_FLAGTYPE_"' type='"_FLAGTYPE_"' assigndt='"_ASSIGNDT_"' apprvBy='"_APPRVBY_"' revDate='"_REVDT
64 ...S LINE=LINE_"' ownerSite='"_OWNER_"' origSite='"_ORIGSITE_"'>"
65 ...D ADD^DGRRLU(LINE)
66 ...D ADD^DGRRLU(" <narrations>")
67 ...N DGRRNI
68 ...S DGRRNI=0
69 ...F S DGRRNI=$O(DGPFFLGS(DGPFI,"NARR",DGRRNI)) Q:'DGRRNI D
70 ....N DGRRNL
71 ....S DGRRNL=$G(DGPFFLGS(DGPFI,"NARR",DGRRNI,0))
72 ....D ADD^DGRRLU(" <narration>"_$$CHARCHK^DGRRUTL(DGRRNL)_"</narration>")
73 ...D ADD^DGRRLU(" </narrations>")
74 ...D ADD^DGRRLU(" </flag>")
75 ..D ADD^DGRRLU(" </businessRule>")
76 ;
7714 ; -- patient merged -- not a requirement
78 DO ADD^DGRRLU(" <businessRule alertId='mergedPatient' recordMergedTo='"_$$CHARCHK^DGRRUTL($P($G(^DPT(DFN,0)),"^",19))_"'></businessRule>")
79 ;
8015 ; -- combat vet status -- being worked on by Edna Curtain.
81 N CVSTATUS,CVEND,DGCV
82 SET (CVSTATUS,CVEND,DGCV)=""
83 I $L($T(CVEDT^DGCV)) S DGCV=$$CVEDT^DGCV(+DFN)
84 I $P(DGCV,"^")=1 D
85 . SET CVSTATUS=$S($P(DGCV,"^",2)>DT:"ELIGIBLE",1:"EXPIRED")
86 . SET CVEND=$P(DGCV,"^",2)
87 DO ADD^DGRRLU(" <businessRule alertId='combatvet' status='"_$$CHARCHK^DGRRUTL($G(CVSTATUS))_"' endDate='"_$$CHARCHK^DGRRUTL($G(CVEND))_"'></businessRule>")
8816 ;Bad Address Indicator
89 N DGRRBA
90 S DGRRBA=$$BADADR^DGUTL3(DFN)
91 DO ADD^DGRRLU(" <businessRule alertId='badAddress' indicator='"_$$CHARCHK^DGRRUTL($G(DGRRBA))_"'></businessRule>")
92 ;
93END QUIT
94 ;
95NOALRT ;Returns an empty alert for Patient Record Flag
96 D ADD^DGRRLU(" <businessRule alertId='patientRecordFlag'>")
97 S LINE=" <flag flagNumber='' category='' type='' assigndt='' apprvBy='' revDate='' ownerSite='' origSite=''>"
98 D ADD^DGRRLU(LINE)
99 D ADD^DGRRLU(" <narrations></narrations>")
100 D ADD^DGRRLU(" </flag>")
101 D ADD^DGRRLU(" </businessRule>")
102 Q
Note: See TracBrowser for help on using the repository browser.