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

IBDFN15.m

Go to the documentation of this file.
  1. IBDFN15 ;ALB/CMR - ENCOUNTER FORM - OUTPUTS;JAN 4, 1996
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;**15**;APR 24, 1997
  1. ;
  1. ; -- clinical reminders interface
  1. ;
  1. SELRM ; -- Select reminders using old structures
  1. N DIC
  1. K @IBARY
  1. W !
  1. S QUIT=0
  1. S DIC("S")="I '$P(^(0),U,6)"
  1. S DIC=811.9,DIC(0)="AEMQZ"
  1. D ^DIC K DIC
  1. I +Y>0 S @IBARY=+Y_"^"_$P(Y(0),"^",3)_"^DUE NOW^LAST ACTIVITY^DUE DATE^COMBO"
  1. Q
  1. ;
  1. DISP ; -- display reminders on encounter form, treat like a dynamic
  1. ; selection list
  1. ;
  1. N I,L,X,Y,Z,ORD,SEL,LAST,IBDCLRM,IBDX,CNT,TEXT,IBCLRMNM,CLRMTYP,COMBO,INVISIBL,NODE,GRPORD,GRP,CLRMCNT
  1. I $G(IBLIST("EDITING CLRM")) G SELRM
  1. ;
  1. I +$G(IBLIST("CLRMLIST"))<1 S IBLIST("CLRMLIST")=2
  1. S CLRMTYP=+$G(IBLIST("CLRMLIST"))-1
  1. K ^TMP("PXRHM",$J),^TMP("PXRM",$J)
  1. K ^TMP("IB",$J,"INTERFACES","PX CLINICAL REMINDERS PRINT")
  1. Q:'$G(DFN)!('$G(IBLIST))
  1. ;
  1. ; -- determine which reminders are due now
  1. ; loop through groups and then selections
  1. S GRPORD=""
  1. F S GRPORD=$O(^IBE(357.4,"APO",+IBLIST,GRPORD)) Q:GRPORD="" S GRP=0 F S GRP=$O(^IBE(357.4,"APO",+IBLIST,GRPORD,GRP)) Q:'GRP D
  1. .S NODE=$G(^IBE(357.4,+GRP,0))
  1. .I $P(NODE,"^")="BLANK"!($P(NODE,"^",4)) S INVISIBL=1
  1. .I '$G(INVISIBL) S CNT=$G(CNT)+1,^TMP("IB",$J,"INTERFACES","PX CLINICAL REMINDERS PRINT",CNT)="0^ "_$P(NODE,"^")
  1. .D ONEGRP
  1. ;
  1. K RTNLIST(RTN("RTN")),^TMP("PXRM",$J),^TMP("PXHRM",$J)
  1. I $G(CLRMCNT)<1 S ^TMP("IB",$J,"INTERFACES","PX CLINICAL REMINDERS PRINT",1)="0^No Reminders in List"
  1. I $G(CLRMCNT),'$D(^TMP("IB",$J,"INTERFACES","PX CLINICAL REMINDERS PRINT")) D
  1. .S ^TMP("IB",$J,"INTERFACES","PX CLINICAL REMINDERS PRINT",1)="0^No. Reminders Evaluated: "_CLRMCNT
  1. .I CLRMTYP S ^TMP("IB",$J,"INTERFACES","PX CLINICAL REMINDERS PRINT",2)="0^None Applicable this patient"
  1. .I 'CLRMTYP S ^TMP("IB",$J,"INTERFACES","PX CLINICAL REMINDERS PRINT",2)="0^None Due Now"
  1. Q
  1. ;
  1. ONEGRP ; -- loop through entries of one group in order
  1. S ORD="" F S ORD=$O(^IBE(357.3,"APO",+IBLIST,GRP,ORD)) Q:ORD="" S SEL=0 F S SEL=$O(^IBE(357.3,"APO",+IBLIST,+GRP,ORD,SEL)) Q:'SEL D
  1. .S IBDCLRM=$G(^IBE(357.3,SEL,0))
  1. .I +IBDCLRM,'$P(IBDCLRM,"^",2) D
  1. ..S CLRMCNT=$G(CLRMCNT)+1
  1. ..D MAIN^PXRM(DFN,+IBDCLRM,CLRMTYP)
  1. ..S TEXT=$O(^TMP("PXRHM",$J,+IBDCLRM,""))
  1. ..Q:TEXT=""
  1. ..S NODE=$G(^TMP("PXRHM",$J,+IBDCLRM,TEXT))
  1. ..K ^TMP("PXRHM",$J),^TMP("PXRM",$J)
  1. ..I $P(NODE,"^")="N/A" Q ;don't display not applicables
  1. ..I CLRMTYP=0,$P(NODE,"^")'="DUE NOW" Q ;type of list DUE NOW only
  1. ..S LAST=$P(NODE,"^",3) I +LAST,$L($P(LAST,"."))=7 S LAST=$$FMTE^XLFDT(LAST)
  1. ..I $P(NODE,"^",5)="E" S LAST=LAST_" (E)" ;last activity was historical encounter, see px*1*38
  1. ..S CNT=$G(CNT)+1
  1. ..S COMBO=$S($P(NODE,"^")="DUE NOW":"DUE NOW",1:$$FMTE^XLFDT($P(NODE,"^",2)))
  1. ..S ^TMP("IB",$J,"INTERFACES","PX CLINICAL REMINDERS PRINT",CNT)="0^"_TEXT_"^"_$P(NODE,"^")_"^"_$$FMTE^XLFDT($P(NODE,"^",2))_"^"_LAST_"^"_COMBO
  1. .;
  1. .I $P(IBDCLRM,"^",2) S CNT=$G(CNT)+1,^TMP("IB",$J,"INTERFACES","PX CLINICAL REMINDERS PRINT",CNT)="0^ "_$P(IBDCLRM,"^",6)
  1. Q
  1. ;
  1. TEST ;
  1. N DFN,IBLIST,RTN,X
  1. K ^TMP("IB",$J,"INTERFACES","PX CLINICAL REMINDERS PRINT")
  1. S DFN=7169761 ;mnt,vbb-male
  1. ;S DFN=7170189 ;mnt,vbb-female
  1. ;S DFN=712 ;dev,den-male
  1. S IBLIST("CLRMLIST")=2
  1. S IBLIST=489 ;dev,den
  1. S IBLIST=430 ;mnt,vbb
  1. S RTN("RTN")="IBDFN15"
  1. D DISP
  1. T1 S X="" F S X=$O(^TMP("IB",$J,"INTERFACES","PX CLINICAL REMINDERS PRINT",X)) Q:'X W !,^(X)
  1. Q