source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY134.m@ 653

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

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1ORY134 ;SLC/DAN ;3/28/02 12:35
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**134**;Dec 17, 1997
3 ;
4 ;Finds current orders with incorrect fractional dose entries containing two decimal places.
5 ;
6 N ORMSG,ZTSK
7 S ORMSG(1)=""
8 S ORMSG(2)="This patch contains a post-init. This post-init will"
9 S ORMSG(3)="run in the background and will identify potential fractional dose problems."
10 S ORMSG(4)="It will then send a mail message to the iniator and holders of the PSNMGR key"
11 S ORMSG(5)="indicating which orders need to be reviewed."
12 S ORMSG(6)=""
13 D MES^XPDUTL(.ORMSG)
14 S ZTRTN="DQ^ORY134",ZTDESC="Patch OR*3*134 database review",ZTIO="",ZTSAVE("DUZ")="",ZTDTH=$H
15 D ^%ZTLOAD
16 I $G(ZTSK) D MES^XPDUTL("Post-init queued to background as task number "_ZTSK_".")
17 Q
18 ;
19DQ ;Enter here for queued task
20 K ^TMP("ORFIX",$J)
21 D FIX,MAIL
22 K ^TMP("ORFIX",$J),^TMP("ORTXT",$J)
23 Q
24 ;
25FIX ;This section will identify active orders with fractional dose problems
26 N PAT,DATE,IEN,PTID
27 S PAT=""
28 F S PAT=$O(^OR(100,"AC",PAT)) Q:PAT="" D
29 .S DATE=0 F S DATE=$O(^OR(100,"AC",PAT,DATE)) Q:'+DATE D
30 ..S IEN=0 F S IEN=$O(^OR(100,"AC",PAT,DATE,IEN)) Q:'+IEN D
31 ...Q:$$NMSP^ORCD($P($G(^OR(100,IEN,0)),U,14))'="PS" ;quit if not pharmacy
32 ...S PTID=$$PTID(PAT) Q:PTID=-1 ;get patient ID quit if referral or couldn't determine name
33 ...I $$VALUE^ORX8(IEN,"INSTR")["0.." I '$$UPDT S ^TMP("ORFIX",$J,$P($$STATUS^ORQOR2(IEN),U,2),PTID,IEN)=$$DRUG
34 Q
35 ;
36MAIL ;Send results of review in a mail message to initiator
37 N I,XMSUB,XMTEXT,XMDUZ,XMY,STA,IEN,PAT
38 S XMSUB="Patch OR*3*134 review completed"
39 S XMDUZ="Patch OR*3*134 Post-Init"
40 S XMY(.5)="" S:$G(DUZ) XMY(DUZ)="" D PSNMGR(.XMY)
41 S XMTEXT="^TMP(""ORTXT"",$J,"
42 K ^TMP("ORTXT",$J)
43 S I=1
44 S ^TMP("ORTXT",$J,I)="The database review for patch OR*3*134 has completed.",I=I+1
45 S ^TMP("ORTXT",$J,I)="Below is a listing of patients that need to have",I=I+1
46 S ^TMP("ORTXT",$J,I)="their prescriptions reviewed and possibly updated.",I=I+1
47 S ^TMP("ORTXT",$J,I)="",I=I+1
48 S ^TMP("ORTXT",$J,I)="For orders in an active (active, pending, hold, etc) state it is",I=I+1
49 S ^TMP("ORTXT",$J,I)="recommended that the order be evaluated and updated according to",I=I+1
50 S ^TMP("ORTXT",$J,I)="the following guidelines.",I=I+1
51 S ^TMP("ORTXT",$J,I)="",I=I+1
52 S ^TMP("ORTXT",$J,I)="If the order has refills remaining or if the order can",I=I+1
53 S ^TMP("ORTXT",$J,I)="potentially be renewed, edit the invalid dosage which will",I=I+1
54 S ^TMP("ORTXT",$J,I)="create a new order with a valid SIG. The appropriate number",I=I+1
55 S ^TMP("ORTXT",$J,I)="of remaining refills must then be added to the new order.",I=I+1
56 S ^TMP("ORTXT",$J,I)="",I=I+1
57 S ^TMP("ORTXT",$J,I)="If the order has no refills remaining and the order will not",I=I+1
58 S ^TMP("ORTXT",$J,I)="be renewed then the order should be discontinued.",I=I+1
59 S ^TMP("ORTXT",$J,I)="",I=I+1
60 S ^TMP("ORTXT",$J,I)="Depending on the status of the order the DRUG listed in the report",I=I+1
61 S ^TMP("ORTXT",$J,I)="will either be a dispense drug or an orderable item.",I=I+1
62 S ^TMP("ORTXT",$J,I)="",I=I+1
63 I '$D(^TMP("ORFIX",$J)) S ^TMP("ORTXT",$J,I)="No problems were found. No manual intervention is required.",I=I+1
64 S ^TMP("ORTXT",$J,I)="",I=I+1
65 S STA="" F S STA=$O(^TMP("ORFIX",$J,STA)) Q:STA="" D
66 .S ^TMP("ORTXT",$J,I)="Order Status - "_STA,I=I+1,^TMP("ORTXT",$J,I)="",I=I+1
67 .S PAT=0 F S PAT=$O(^TMP("ORFIX",$J,STA,PAT)) Q:PAT="" D
68 ..S IEN=0 F S IEN=$O(^TMP("ORFIX",$J,STA,PAT,IEN)) Q:'+IEN D
69 ...S ^TMP("ORTXT",$J,I)=PAT_$$REPEAT^XLFSTR(" ",(40-$L(PAT)))_"DRUG = "_^TMP("ORFIX",$J,STA,PAT,IEN),I=I+1
70 .S ^TMP("ORTXT",$J,I)="",I=I+1
71 D ^XMD ;send results
72 Q
73 ;
74PTID(IEN) ;Return pt name and 1A4U identifiers or -1 if unable to determine
75 N DFN,VADM
76 I +IEN=0!(IEN'["DPT") Q -1
77 S DFN=+IEN
78 D ^VADPT
79 I $G(VADM(1))="" Q -1
80 Q $E(VADM(1),1)_$E(VADM(2),6,9)_" "_VADM(1)
81 ;
82UPDT() ;Function to determine if order has been updated yet.
83 N TXT,I,UPDT
84 S UPDT=1
85 D TEXT^ORQ12(.TXT,IEN_";"_$P($G(^OR(100,IEN,3)),U,7),80) ;get current order text
86 F I=1:1:TXT I TXT(I)["0.." S UPDT=0 Q
87 Q UPDT
88 ;
89DRUG() ;Get dispense drug or orderable item
90 N VALUE
91 S VALUE=$$VALUE^ORX8(IEN,"DRUG",,"E")
92 I VALUE="" S VALUE=$$VALUE^ORX8(IEN,"ORDERABLE",,"E")
93 Q VALUE
94 ;
95PSNMGR(XMY) ;Add PSNMGR key holders to XMY array
96 ;DBIA 10076 allows direct read of XUSEC
97 N USER
98 S USER=0 F S USER=$O(^XUSEC("PSNMGR",USER)) Q:'USER S XMY(USER)=""
99 Q
Note: See TracBrowser for help on using the repository browser.