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

GMRPNCW.m

Go to the documentation of this file.
  1. GMRPNCW ;SLC/DJP,MKB,MJC - CWAD Utility ;Jan 13, 2021@10:55
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**120,341**;Jun 20, 1997;Build 23
  1. EN ;Entry for secondary option to lookup patient, display warnings
  1. Q:IOST?1"P".E D SETUP("REVIEW PATIENT WARNINGS")
  1. N X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. S GMRPEN=1,GMRPOPT=1
  1. F D Q:$D(GMRPQT)
  1. .W ! S DIC="^DPT(",DIC(0)="AEQM" D ^DIC
  1. .S:(Y<1)!($D(DTOUT))!($D(DUOUT))!($D(DIROUT)) GMRPQT=1
  1. K GMRPQT,GMRPEN,GMRPOPT,GMRPDFN,DIC,VAROOT
  1. Q
  1. SETUP(TITLE) ;entry utilities, option header
  1. N GMRPI K GMRPQT,GMRPSTOP,GMRPLIST,GMRPOPT,GMRPAT
  1. W @IOF,!!?(IOM-$L(TITLE)\2),TITLE,! F GMRPI=1:1:IOM W "-"
  1. W !
  1. Q
  1. ENPAT ;Additional entry point; must be passed Patient DFN in Y.
  1. ;Setting GMRPEN permits individual options to turn on the Clin Alerts.
  1. ;When ON, the keys GMRPC and/or GMRPWA may be required in the future.
  1. Q:'$D(GMRPEN)
  1. Q:+Y<1 N DIC,DFN,GMRPTYP
  1. S (GMRPDFN,DFN)=+Y,$P(GMRPDFN,U,2)=$P(^DPT(+GMRPDFN,0),U)
  1. D ALLERGY,WH
  1. I '$D(^TIU(8925,"ADCPT",+GMRPDFN)),'$D(GMRPALG),$S($D(GMRPOPT):1,$D(GMRPHOLD):1,1:0),'$D(GMRPWH) D Q
  1. . W !!,"No Patient Warnings on file for "
  1. . W $P(GMRPDFN,U,2),".",!
  1. . I $$READ^TIUU("EA","Press RETURN to continue...") ; pause
  1. D CWLKP I $D(GMRPOPT),'$D(GMRPQT) D PRINT
  1. END K GMRPQT,GMRPCWA,GMRPALG,GMRPX,X,CWA,GMRPWH
  1. Q
  1. CWLKP ;Lookup and presentation of CWA indicators
  1. S GMRPCWA=""
  1. F CWA("DOCTYPE")=30,31,27 D
  1. . 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
  1. I $D(GMRPALG) S GMRPCWA=GMRPCWA_"A" W !?24,"A: Known allergies"
  1. S GMRPCWA=GMRPCWA_$G(GMRPWH)
  1. I $G(GMRPWH)["P" W !,?24,"P: Pregnant"
  1. I $G(GMRPWH)["L" W !,?24,"L: Lactating"
  1. I '$L(GMRPCWA) S GMRPQT=1 Q
  1. I '$D(GMRPOPT),$D(GMRPHOLD) W ! N DIR,X,Y S DIR(0)="E" D ^DIR W:$D(DIRUT)!(Y=1) ! Q
  1. D RESPOND:$D(GMRPOPT)
  1. Q
  1. LIST ;List data lines -- expects GMRPTYP="C" or "W" or "A" or "D"
  1. N GMRPDT,GMRPIFN,GMRPDDT,CTR,COUNT,STATUS
  1. S GMRPCWA=GMRPCWA_GMRPTYP
  1. ; GMRP*2.5*50 include amended as well as complete:
  1. S GMRPDT(7)=$O(^TIU(8925,"ADCPT",+GMRPDFN,CWA("DOCTYPE"),7,0))
  1. S GMRPDT(8)=$O(^TIU(8925,"ADCPT",+GMRPDFN,CWA("DOCTYPE"),8,0))
  1. ; Get inverse date & status of most recent complete or amended note:
  1. I 'GMRPDT(7) S GMRPDT=+GMRPDT(8) Q:'GMRPDT S STATUS=8
  1. I '$G(GMRPDT) I 'GMRPDT(8) S GMRPDT=+GMRPDT(7) Q:'GMRPDT S STATUS=7
  1. I '$G(GMRPDT) D
  1. . I GMRPDT(7)<GMRPDT(8) S GMRPDT=GMRPDT(7),STATUS=7 Q
  1. . S GMRPDT=GMRPDT(8),STATUS=8
  1. S GMRPDDT=$$DATE^TIULS((9999999-GMRPDT),"MM/DD/YY HR:MIN")
  1. S (CTR,COUNT)=0
  1. 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
  1. S COUNT=0
  1. 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
  1. W !?11," (",CTR," note",$S(CTR>1:"s",1:" "),")",?24,GMRPTYP,": ",GMRPDDT
  1. W $$ADDEND(STATUS)
  1. Q
  1. ADDEND(STATUS) ; If addended or amended, return most recent of these, for most recent note.
  1. N IEN,AMENDDT,ADDMDT,ADDMIEN,AAMENDDT,MAX,MSG
  1. ; GMRP*2.5*50, get most recent complete OR AMENDED note:
  1. S IEN=0
  1. S IEN=$O(^TIU(8925,"ADCPT",+GMRPDFN,CWA("DOCTYPE"),STATUS,GMRPDT,IEN))
  1. S AMENDDT=+$G(^TIU(8925,IEN,16)) ;date of note amendment
  1. S ADDMIEN=+$O(^TIU(8925,"DAD",IEN,""),-1) ; IEN of most recent addendum
  1. I +$P($G(^TIU(8925,ADDMIEN,0)),U,5)<7 S ADDMIEN=0 ;forget addm if not signed
  1. S ADDMDT=+$G(^TIU(8925,ADDMIEN,12)) ; date of addm
  1. S AAMENDDT=+$G(^TIU(8925,ADDMIEN,16)) ;date of addm amendment
  1. I AAMENDDT>AMENDDT S AMENDDT=AAMENDDT
  1. S MAX=$S(AMENDDT>ADDMDT:AMENDDT,1:ADDMDT)
  1. I MAX=0 S MSG="" G ADDX
  1. I MAX=AMENDDT S MSG=" (amended "_$$DATE^TIULS(AMENDDT,"MM/DD/YY HR:MIN")_")" G ADDX
  1. S MSG=" (addendum "_$$DATE^TIULS(ADDMDT,"MM/DD/YY HR:MIN")_")"
  1. ADDX Q MSG
  1. ;
  1. RESPOND ;prompt for warnings to display
  1. W !!,"Select patient warning(s) to display: "_GMRPCWA_"//"
  1. R GMRPX:60 I '$T!(GMRPX["^") S GMRPQT=1 Q
  1. S:GMRPX="" GMRPX=GMRPCWA
  1. I GMRPX["?" D QUES K GMRPX G RESPOND
  1. S GMRPX=$$UP^XLFSTR(GMRPX)
  1. Q
  1. PRINT ;Prints Crisis Notes, Clin Warnings & Allergies using HS utilities.
  1. S X="GMTS" X ^%ZOSF("TEST") I '$T W $C(7) D Q
  1. .W !,"This display uses the Health Summary, currently unavailable.",!
  1. N GMTSTITL,GMTSPRM,GMRPHSTYPE S GMTSTITL="PATIENT WARNINGS",GMTSPRM=""
  1. S:GMRPX["C" GMTSPRM="CN"
  1. I $L($T(CD^GMTSCW)) D
  1. .S:GMRPX["W" GMTSPRM=GMTSPRM_",CW"
  1. .S:GMRPX["D" GMTSPRM=GMTSPRM_",CD"
  1. I '$L($T(CD^GMTSCW)) D
  1. .S:GMRPX["W"!(GMRPX["D") GMTSPRM=GMTSPRM_",CW"
  1. S:GMRPX["A" GMTSPRM=GMTSPRM_",ADR"
  1. I GMTSPRM="" S GMRPQT=1
  1. I GMTSPRM'="" D
  1. .I $E(GMTSPRM)="," S GMTSPRM=$P(GMTSPRM,",",2,5)
  1. .D ENCWA^GMTS
  1. I GMRPX["P",GMRPX["L" S GMRPHSTYPE="VA-WH PREG & LAC STATUS"
  1. E D
  1. .I GMRPX["P" S GMRPHSTYPE="VA-WH PREGNANCY STATUS"
  1. .I GMRPX["L" S GMRPHSTYPE="VA-WH LACTATION STATUS"
  1. I $G(GMRPHSTYPE)'="" D
  1. .K GMRPQT,^TMP("DIERR",$J)
  1. .S GMRPHSTYPE("NAME")=GMRPHSTYPE,GMRPHSTYPE=$$FIND1^DIC(142,,"X",GMRPHSTYPE)
  1. .I +GMRPHSTYPE=0 D Q
  1. ..W !!,"Could not find the "_GMRPHSTYPE("NAME")_" health summary type."
  1. ..I $D(^TMP("DIERR",$J)) W ! D MSG^DIALOG() K ^TMP("DIERR",$J)
  1. ..S GMRPQT=1
  1. .D ENX^GMTSDVR(DFN,GMRPHSTYPE)
  1. Q
  1. QUES ;Response to "?" at CWA prompt
  1. W !!," Enter:"
  1. W !?8,"C for Crisis Notes",!?8,"W for Clinical Warnings"
  1. W !?8,"A for Allergies",!?8,"D for Directive Notes"
  1. W !?8,"P for Pregnant",!,?8,"L for Lactating"
  1. W !?8,"CWADPL for all 6 patient warnings"
  1. W !!?8,"or any combination of C, W, A, D, P and L without commas."
  1. Q
  1. ALLERGY ;checks for allergies on file for patient - requires GMRPDFN
  1. ;Returns GMRPALG if allergies found ('$D if none)
  1. K GMRPALG,GMRA
  1. S X="GMRADPT" X ^%ZOSF("TEST") I $T D Q
  1. .D EN1^GMRADPT S:+$G(GMRAL) GMRPALG=1 K GMRAL
  1. I $D(^DPT(+GMRPDFN,"PA",0)),$P(^(0),U,4)>0 S GMRPALG=1
  1. Q
  1. WH ;Retrieves pregnancy and lactation status for patient
  1. K GMRPWH
  1. S GMRPWH=$$POSTSHRT^WVRPCOR(+GMRPDFN)
  1. Q