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

ORY182.m

Go to the documentation of this file.
  1. ORY182 ;SLC/DAN Delete incorrect allergy orders ;5/20/03 15:44
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**182**;Dec 17, 1997
  1. ;
  1. ;DBIA SECTION
  1. ;10141 - XPDUTL
  1. ;10070 - XMD
  1. ;10061 - VADPT
  1. ;10063 - %ZTLOAD
  1. ;10013 - DIK
  1. ;2056 - DIQ
  1. ;10067 - XMA21
  1. ;10060 - Access to file 200
  1. ;10103 - XLFDT
  1. ;
  1. POST ;Search for problems, produce report, fix problems
  1. N ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSAVE,ZTSK
  1. D BMES^XPDUTL("Starting allergy order clean-up in background...")
  1. S ZTRTN="EN^ORY182",ZTIO="",ZTDESC="Allergy order clean up",ZTDTH=$H,ZTSAVE("DUZ")="" D ^%ZTLOAD
  1. Q
  1. ;
  1. EN ;Start here
  1. N ORI,ORCNT
  1. K ^TMP("ORALDAT",$J)
  1. S ORCNT=0
  1. S ORI=$$GETIEN(2980101) F S ORI=$O(^OR(100,ORI)) Q:'+ORI D
  1. .I '$D(^OR(100,ORI,0)) D ERR Q ;Record missing 0 nodes.
  1. .Q:$$NMSP^ORCD($P(^OR(100,ORI,0),U,14))'="GMRA" ;Stop if not an allergy order
  1. .Q:$P(^OR(100,ORI,3),U,3)'=11 ;Stop if order doesn't have "unreleased" status
  1. .Q:'('$D(^OR(100,ORI,4.5,"ID","TYPE"))&($D(^OR(100,ORI,4.5,"ID","OBSERVED")))) ;Stop if responses multiple doesn't match what we're looking for
  1. .D STORE,FIX
  1. D MAIL
  1. K ^TMP("ORALDAT",$J)
  1. Q
  1. ;
  1. STORE ;Store information regarding order for mail message
  1. N NAME,SSN,DFN,TEXT,VADM
  1. S DFN=+$P(^OR(100,ORI,0),U,2)
  1. D DEM^VADPT
  1. S SSN=$E(+VADM(2),6,9)
  1. S NAME=VADM(1)
  1. S TEXT=$G(^OR(100,ORI,8,1,.1,1,0))
  1. S ORCNT=ORCNT+1
  1. S ^TMP("ORALDAT",$J,ORCNT)=NAME_U_SSN_U_$$GET1^DIQ(100,ORI,3,"E")_U_$$GET1^DIQ(100,ORI,4,"E")_U_TEXT
  1. Q
  1. ;
  1. FIX ;Delete the erroneous entry in file 100
  1. N DA,DIK
  1. S DA=ORI,DIK="^OR(100," D ^DIK ;*poof*
  1. Q
  1. ;
  1. MAIL ;Send mail message to initiator detailing results
  1. N XMSUB,XMTEXT,XMDUZ,XMY,XMZ,XMMG,ORTXT,ORJ,ORK,LINE,DIFROM
  1. S XMDUZ="Allergy order clean up"
  1. I $D(^XTMP("ORY182","XMY")) M XMY=^XTMP("ORY182","XMY") K ^XTMP("ORY182")
  1. I '$D(XMY) S XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
  1. S ORTXT(1)="The allergy order clean up process has finished.",ORTXT(2)="",ORK=3
  1. I ORCNT=0&('$D(^TMP("ORALDAT",$J,"ERR"))) S ORTXT(3)="No problems found. No additional review is required."
  1. I ORCNT'=0 D
  1. .S ORTXT(3)="Following is information regarding orders that were deleted."
  1. .S ORTXT(4)="Please review any findings to make sure the patient's"
  1. .S ORTXT(5)="allergy information is correct. Information shown here was NOT transmitted"
  1. .S ORTXT(6)="to the allergy package and may not have been correctly reported."
  1. .S ORTXT(7)="",ORTXT(8)="Information below is patient name, last 4, who entered, date",ORTXT(9)="entered, and order text.",ORTXT(10)=""
  1. .S ORK=11
  1. .F ORJ=1:1:ORCNT D
  1. ..S LINE=^TMP("ORALDAT",$J,ORJ)
  1. ..S ORTXT(ORK)=$P(LINE,U)_" "_$P(LINE,U,2)_" "_$P(LINE,U,3)_" "_$P(LINE,U,4),ORK=ORK+1
  1. ..S ORTXT(ORK)=$P(LINE,U,5),ORK=ORK+1,ORTXT(ORK)="",ORK=ORK+1
  1. I $D(^TMP("ORALDAT",$J,"ERR")) D
  1. .S ORTXT(ORK)="The following internal entry numbers from file 100 are missing",ORK=ORK+1,ORTXT(ORK)="zero nodes. You need to review each entry and take corrective action.",ORK=ORK+1,ORTXT(ORK)="Log a NOIS if you need assistance."
  1. .S ORK=ORK+1,ORTXT(ORK)=""
  1. .S ORK=ORK+1,ORJ=0 F S ORJ=$O(^TMP("ORALDAT",$J,"ERR",ORJ)) Q:'+ORJ S ORTXT(ORK)=ORJ,ORK=ORK+1
  1. S XMTEXT="ORTXT(",XMSUB="Patch OR*3*182 allergy order report"
  1. D ^XMD
  1. Q
  1. ;
  1. PRE ;Obtain names to send mail message to
  1. N XMDUZ,XMDUN,XMY,ORTXT,DIFROM
  1. Q:$D(ZTQUEUED) ;Quit if being queued, can't ask for recipients
  1. I +$G(DUZ)=0 D MES^XPDUTL("You must set your DUZ before installing this patch. Installation aborted!") S XPDABORT=1 Q
  1. S ORTXT(1)="This patch produces a report of patients with potential allergy order"
  1. S ORTXT(2)="problems. Patient charts must be reviewed to be certain that allergy"
  1. S ORTXT(3)="information is correct. Please identify recipients for this report."
  1. S ORTXT(4)=""
  1. D BMES^XPDUTL(.ORTXT)
  1. S XMDUZ=$G(DUZ)
  1. S XMDUN=$$GET1^DIQ(200,$G(DUZ),.01)
  1. D DEST^XMA21
  1. I $D(XMOUT) D BMES^XPDUTL("The report will still run and will be sent to you for distribution.") Q ;quit if user doesn't identify any recipients
  1. S ^XTMP("ORY182",0)=$$FMADD^XLFDT($$DT^XLFDT,30) ;auto-deletion in 30 days
  1. M ^XTMP("ORY182","XMY")=XMY ;Move recipient list into XTMP for later use
  1. Q
  1. ;
  1. GETIEN(STDT) ;Find first IEN associated with given start date
  1. N DONE,IEN
  1. S (DONE,IEN)=0
  1. F S STDT=$O(^OR(100,"AF",STDT)) Q:'+STDT!(DONE) D
  1. .S IEN=0 F S IEN=$O(^OR(100,"AF",STDT,IEN)) Q:'+IEN I $O(^(IEN,0))=1 S DONE=1 Q ;Find first ORDER that is a new order
  1. Q IEN
  1. ;
  1. ERR ;Record missing 0 node errors
  1. S ^TMP("ORALDAT",$J,"ERR",ORI)=""
  1. Q