source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/GMRPNCW.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1GMRPNCW ;SLC/DJP,MKB,MJC - CWAD Utility ;07-SEP-2001 16:11
2 ;;1.0;TEXT INTEGRATION UTILITIES;**120**;Jun 20, 1997
3EN ;Entry for secondary option to lookup patient, display warnings
4 Q:IOST?1"P".E D SETUP("REVIEW PATIENT WARNINGS")
5 S GMRPEN=1,GMRPOPT=1
6 F D Q:$D(GMRPQT)
7 .W ! S DIC="^DPT(",DIC(0)="AEQM" D ^DIC
8 .S:(Y<1)!($D(DTOUT))!($D(DUOUT))!($D(DIROUT)) GMRPQT=1
9 K GMRPQT,GMRPEN,GMRPOPT,GMRPDFN,DIC,VAROOT
10 Q
11SETUP(TITLE) ;entry utilities, option header
12 N GMRPI K GMRPQT,GMRPSTOP,GMRPLIST,GMRPOPT,GMRPAT
13 W @IOF,!!?(IOM-$L(TITLE)\2),TITLE,! F GMRPI=1:1:IOM W "-"
14 W !
15 Q
16ENPAT ;Additional entry point; must be passed Patient DFN in Y.
17 ;Setting GMRPEN permits individual options to turn on the Clin Alerts.
18 ;When ON, the keys GMRPC and/or GMRPWA may be required in the future.
19 Q:'$D(GMRPEN)
20 Q:+Y<1 N DIC,DFN,GMRPTYP
21 S (GMRPDFN,DFN)=+Y,$P(GMRPDFN,U,2)=$P(^DPT(+GMRPDFN,0),U)
22 D ALLERGY
23 I '$D(^TIU(8925,"ADCPT",+GMRPDFN)),'$D(GMRPALG),$S($D(GMRPOPT):1,$D(GMRPHOLD):1,1:0) D Q
24 . W !!,"No Patient Warnings on file for "
25 . W $P(GMRPDFN,U,2),".",!
26 . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
27 D CWLKP I $D(GMRPOPT),'$D(GMRPQT) D PRINT
28END K GMRPQT,GMRPCWA,GMRPALG,GMRPX,X,CWA
29 Q
30CWLKP ;Lookup and presentation of CWA indicators
31 S GMRPCWA="",CTR=0
32 F CWA("DOCTYPE")=30,31,27 D
33 . I $D(^TIU(8925,"ADCPT",+GMRPDFN,CWA("DOCTYPE"),7))!$D(^TIU(8925,"ADCPT",+GMRPDFN,CWA("DOCTYPE"),8)) S GMRPTYP=$S(CWA("DOCTYPE")=30:"C",CWA("DOCTYPE")=31:"W",1:"D") D LIST ;GMRP*2.5*50 include amended as well as complete
34 I $D(GMRPALG) S GMRPCWA=GMRPCWA_"A" W !?24,"A: Known allergies"
35 I '$L(GMRPCWA) S GMRPQT=1 Q
36 I '$D(GMRPOPT),$D(GMRPHOLD) W ! N DIR S DIR(0)="E" D ^DIR W:$D(DIRUT)!(Y=1) ! Q
37 D RESPOND:$D(GMRPOPT)
38 Q
39LIST ;List data lines -- expects GMRPTYP="C" or "W" or "A" or "D"
40 N GMRPDT,GMRPIFN,GMRPDDT,CTR,COUNT,STATUS
41 S GMRPCWA=GMRPCWA_GMRPTYP
42 ; GMRP*2.5*50 include amended as well as complete:
43 S GMRPDT(7)=$O(^TIU(8925,"ADCPT",+GMRPDFN,CWA("DOCTYPE"),7,0))
44 S GMRPDT(8)=$O(^TIU(8925,"ADCPT",+GMRPDFN,CWA("DOCTYPE"),8,0))
45 ; Get inverse date & status of most recent complete or amended note:
46 I 'GMRPDT(7) S GMRPDT=+GMRPDT(8) Q:'GMRPDT S STATUS=8
47 I '$G(GMRPDT) I 'GMRPDT(8) S GMRPDT=+GMRPDT(7) Q:'GMRPDT S STATUS=7
48 I '$G(GMRPDT) D
49 . I GMRPDT(7)<GMRPDT(8) S GMRPDT=GMRPDT(7),STATUS=7 Q
50 . S GMRPDT=GMRPDT(8),STATUS=8
51 S GMRPDDT=$$DATE^TIULS((9999999-GMRPDT),"MM/DD/YY HR:MIN")
52 S (CTR,COUNT)=0
53 F S COUNT=$O(^TIU(8925,"ADCPT",+GMRPDFN,CWA("DOCTYPE"),7,COUNT)) Q:+COUNT'>0 S CTR=CTR+1 ;Counts the number of COMPLETE warnings on file
54 S COUNT=0
55 F S COUNT=$O(^TIU(8925,"ADCPT",+GMRPDFN,CWA("DOCTYPE"),8,COUNT)) Q:+COUNT'>0 S CTR=CTR+1 ; GMRP*2.5*50, adds the number of amended warnings on file
56 W !?11," (",CTR," note",$S(CTR>1:"s",1:" "),")",?24,GMRPTYP,": ",GMRPDDT
57 W $$ADDEND(STATUS)
58 Q
59ADDEND(STATUS) ; If addended or amended, return most recent of these, for most recent note.
60 N IEN,AMENDDT,ADDMDT,ADDMIEN,AAMENDDT,MAX,MSG
61 ; GMRP*2.5*50, get most recent complete OR AMENDED note:
62 S IEN=0
63 S IEN=$O(^TIU(8925,"ADCPT",+GMRPDFN,CWA("DOCTYPE"),STATUS,GMRPDT,IEN))
64 S AMENDDT=+$G(^TIU(8925,IEN,16)) ;date of note amendment
65 S ADDMIEN=+$O(^TIU(8925,"DAD",IEN,""),-1) ; IEN of most recent addendum
66 I +$P($G(^TIU(8925,ADDMIEN,0)),U,5)<7 S ADDMIEN=0 ;forget addm if not signed
67 S ADDMDT=+$G(^TIU(8925,ADDMIEN,12)) ; date of addm
68 S AAMENDDT=+$G(^TIU(8925,ADDMIEN,16)) ;date of addm amendment
69 I AAMENDDT>AMENDDT S AMENDDT=AAMENDDT
70 S MAX=$S(AMENDDT>ADDMDT:AMENDDT,1:ADDMDT)
71 I MAX=0 S MSG="" G ADDX
72 I MAX=AMENDDT S MSG=" (amended "_$$DATE^TIULS(AMENDDT,"MM/DD/YY HR:MIN")_")" G ADDX
73 S MSG=" (addendum "_$$DATE^TIULS(ADDMDT,"MM/DD/YY HR:MIN")_")"
74ADDX Q MSG
75 ;
76RESPOND ;prompt for warnings to display
77 W !!,"Select patient warning(s) to display: "_GMRPCWA_"//"
78 R GMRPX:60 I '$T!(GMRPX["^") S GMRPQT=1 Q
79 S:GMRPX="" GMRPX=GMRPCWA
80 I GMRPX["?" D QUES K GMRPX G RESPOND
81 S GMRPX=$$UP^XLFSTR(GMRPX)
82 Q
83PRINT ;Prints Crisis Notes, Clin Warnings & Allergies using HS utilities.
84 S X="GMTS" X ^%ZOSF("TEST") I '$T W $C(7) D Q
85 .W !,"This display uses the Health Summary, currently unavailable.",!
86 N GMTSTITL,GMTSPRM S GMTSTITL="PATIENT WARNINGS",GMTSPRM=""
87 S:GMRPX["C" GMTSPRM="CN"
88 I $L($T(CD^GMTSCW)) D
89 .S:GMRPX["W" GMTSPRM=GMTSPRM_",CW"
90 .S:GMRPX["A" GMTSPRM=GMTSPRM_",ADR"
91 .S:GMRPX["D" GMTSPRM=GMTSPRM_",CD"
92 E D
93 .S:GMRPX["W"!(GMRPX["D") GMTSPRM=GMTSPRM_",CW"
94 .S:GMRPX["A" GMTSPRM=GMTSPRM_",ADR"
95 I GMTSPRM="" S GMRPQT=1 Q
96 I $E(GMTSPRM)="," S GMTSPRM=$P(GMTSPRM,",",2,5)
97 D ENCWA^GMTS
98 Q
99QUES ;Response to "?" at CWA prompt
100 W !!," Enter:"
101 W !?8,"C for Crisis Notes",!?8,"W for Clinical Warnings"
102 W !?8,"A for Allergies",!?8,"D for Directive Notes"
103 W !?8,"CWAD for all 4 patient warnings"
104 W !!?8,"or any combination of C, W, A, and D without commas."
105 Q
106ALLERGY ;checks for allergies on file for patient - requires GMRPDFN
107 ;Returns GMRPALG if allergies found ('$D if none)
108 K GMRPALG,GMRA
109 S X="GMRADPT" X ^%ZOSF("TEST") I $T D Q
110 .D EN1^GMRADPT S:+$G(GMRAL) GMRPALG=1 K GMRAL
111 I $D(^DPT(+GMRPDFN,"PA",0)),$P(^(0),U,4)>0 S GMRPALG=1
112 Q
Note: See TracBrowser for help on using the repository browser.