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

ORY354.m

Go to the documentation of this file.
  1. ORY354 ;DJE-Search for anticoag patients with blank notes ;06/20/13 09:21
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**354**;Jun 20, 2013;Build 12
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. EN1 ;
  1. I $G(DUZ)="" W "Your DUZ is not defined.",! Q
  1. N ZTDESC,ZTIO,ZTRTN,ZTSK,ZTSAVE
  1. TASK S ZTRTN="EN^ORY354",ZTIO=""
  1. S ZTDESC="Check for anticoag patients with blank notes"
  1. D ^%ZTLOAD
  1. W !!,"The check for anticoag patients with blank notes is",$S($D(ZTSK):"",1:" NOT")," queued",!
  1. I $D(ZTSK) W " (to start NOW).",!!,"YOU WILL RECEIVE A MAILMAN MESSAGE WHEN TASK #"_ZTSK_" HAS COMPLETED."
  1. Q
  1. ;
  1. EN ; -- tasked entry point
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. N CREAT,EXPR,DFN,DOCTYPE,SIGDT,NOTEID,COUNTER
  1. D NOW^%DTC S CREAT=$E(%,1,7),EXPR=$$FMADD^XLFDT(CREAT,30,0,0,0) K ^XTMP("ORY354")
  1. S COUNTER=0,DFN=0 F S DFN=$O(^ORAM(103,DFN)) Q:'DFN D ;loop anticoag patients
  1. . S SIGDT=0 F S SIGDT=$O(^TIU(8925,"APTP",DFN,SIGDT)) Q:'SIGDT D ;loop signed notes index
  1. .. S NOTEID=0 F S NOTEID=$O(^TIU(8925,"APTP",DFN,SIGDT,NOTEID)) Q:'NOTEID D
  1. ... I $D(^TIU(8925,NOTEID,"TEXT")) Q ;Not empty, quit
  1. ... I $G(^TIU(8925,NOTEID,0))="" Q ;Bad index, quit
  1. ... ;set node to NAME^NOTE TITLE^NOTE DATE
  1. ... S COUNTER=COUNTER+1,^XTMP("ORY354",COUNTER)=$P(^DPT(DFN,0),U)_"^"_$$PNAME^TIULC1(+^TIU(8925,NOTEID,0))_"^"_$$FMTE^XLFDT($P(^TIU(8925,NOTEID,13),U),"D")
  1. I $D(^XTMP("ORY354")) S ^XTMP("ORY354",0)=EXPR_"^"_CREAT
  1. D SEND
  1. K ZTQUEUED,ZTREQ Q
  1. SEND ;Send message
  1. K ORMSG,XMY N OCNT,COUNTER,XMDUZ,XMSUB,XMTEXT,REC
  1. S XMDUZ="CPRS, SEARCH",XMSUB="ANTICOAG PATIENTS WITH BLANK NOTES",XMTEXT="ORMSG(",XMY(DUZ)=""
  1. S ORMSG(1,0)=" The check for anticoag patients with blank notes is complete."
  1. S ORMSG(2,0)=" ",ORMSG(3,0)=" Here is the list of the affected patients: ",ORMSG(4,0)=" "
  1. S NOTEID=0,ORMSG(5,0)="Patient Note Title Note Date",OCNT=5
  1. I '$D(^XTMP("ORY354")) S ORMSG(6,0)="No notes found."
  1. S OCNT=5,COUNTER=0 F S COUNTER=$O(^XTMP("ORY354",COUNTER)) Q:'COUNTER D
  1. . S REC=^XTMP("ORY354",COUNTER) S OCNT=OCNT+1,ORMSG(OCNT,0)=$$BUF30($P(REC,U,1))_" "_$$BUF30($P(REC,U,2))_" "_$P(REC,U,3)
  1. D ^XMD
  1. Q
  1. BUF30(X) ;Buffer and limit text to 30 characters
  1. S $P(X," ",30)=" " ;add 30 spaces to end of text
  1. Q $E(X,1,30) ;return first 30 characters of text