source: FOIAVistA/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBMLU.m@ 810

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1PSBMLU ;BIRMINGHAM/EFC-BCMA MEDICATION LOG FUNCTIONS ;Mar 2004
2 ;;3.0;BAR CODE MED ADMIN;**6,11,13**;Mar 2004
3 ;;
4 ; Reference/IA
5 ; ^XMD/10070
6 ;
7EN ;
8 Q
9 ;
10AUDIT(IEN,TXT,PSBTRN) ; Append and Audit
11 D NOW^%DTC
12 S RDAT=%
13 D:PSBTRN="ADD COMMENT"
14 . N XA
15 . S XA=$O(^PSB(53.79,IEN,.3,"A"),-1)
16 . S RDAT=$P(^PSB(53.79,IEN,.3,XA,0),U,3)
17 D:PSBTRN="PRN EFFECTIVENESS"
18 . S RDAT=$P(^PSB(53.79,IEN,.2),U,4)
19 D:PSBTRN="UPDATE STATUS"
20 . S RDAT=$P(^PSB(53.79,IEN,0),U,6)
21 D:PSBTRN="MEDPASS"
22 . S RDAT=$P(^PSB(53.79,IEN,0),U,6)
23 S:'$D(^PSB(53.79,IEN,.9,0)) ^(0)="^53.799D^^"
24 S PSBAD1=""
25 S PSBAD1=$O(^PSB(53.79,IEN,.9,"A"),-1)+1
26 S ^PSB(53.79,IEN,.9,PSBAD1,0)=RDAT_U_DUZ_U_TXT
27 Q
28 ;
29ERROR(PSB1,PSB2,DFN,PSB3,PSB4,PSB5,PSB6,PSB7) ;
30 ; PSB1 = order #
31 ; PSB2 = orderable item
32 ; PSB3 = message to be sent
33 ; PSB4 = schedule
34 ; PSB5 = action date/time
35 ; PSB6 = med log ien #
36 ; PSB7 = user identification
37 ; Send Error Msg about problems
38 S PSBMG=$$GET^XPAR("DIV",$S($G(PSBADMER):"PSB MG ADMIN ERROR",1:"PSB MG DUE LIST ERROR"),,"E")
39 Q:PSBMG=""
40 S PSBMSG(1)=" The following "_$S($G(PSBADMER):"administration",1:"order")_" was NOT displayed"
41 S PSBMSG(2)=" on the Virtual Due List"
42 S PSBMSG(3)=" "
43 S PSBMSG(4)=" Order Number....: "_PSB1
44 S PSBMSG(5)=" Orderable Item..: "_PSB2
45 S PSBMSG(6)=" Patient.........: "_$$GET1^DIQ(2,DFN_",",.01)_" ("_$$GET1^DIQ(2,DFN_",",.09)_")"
46 S PSBMSG(7)=" Ward/Bed........: "_$$GET1^DIQ(2,DFN_",",.1)_"/"_$$GET1^DIQ(2,DFN_",",.101)
47 S PSBMSG(8)=" Reason..........: "_PSB3
48 S PSBMSG(9)=" Schedule........: "_PSB4
49 I $D(PSB5) S PSBMSG(10)=" Action Dt/Tm....: "_PSB5
50 I $D(PSB6) S PSBMSG(11)=" BCMA Med Log IEN: "_PSB6
51 I $D(PSB7) S PSBMSG(12)=" User............: "_PSB7
52 S XMY("G."_PSBMG)="",XMTEXT="PSBMSG(",XMSUB="BCMA - "_$S($G(PSBADMER):"Admin "_$G(PSB6),1:"Order")_" Problem"
53 K PSBADMER
54 D ^XMD
55 K PSB1,PSB2,PSB3,PSB4,PSBMSG,PSBMG,XMY,XMSUB,XMTEXT
56 Q
57 ;
Note: See TracBrowser for help on using the repository browser.