source: FOIAVistA/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBPRND.m

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1PSBPRND ;BIRMINGHAM/EFC-BCMA PRN DOCUMENTING ;May 2002
2 ;;2.0;BAR CODE MED ADMIN;**32**;May 2002
3 ;
4 ;Queue the routine
5ENV(PSBPRNDT,PSBSTRT,PSBDUZ,PRNMSG) ;
6 I $G(DUZ)="" W !,"Your DUZ is not defined. It must be defined." Q
7 K ZTSAVE,ZTSK S ZTRTN="PROCESS^PSBPRND(PSBPRNDT,PSBSTRTE,PSBDUZ,PSBPRNM)",ZTDESC="BCMA PRN DOCUMENTATION",ZTIO=""
8 W !!
9 S ZTSAVE("PSBPRNDT")=""
10 S ZTSAVE("PSBSTRTE")=""
11 S ZTSAVE("PSBDUZ")=""
12 S ZTSAVE("PSBPRNM")=""
13 D ^%ZTLOAD
14 I $D(ZTSK) D
15 .W !!,"The PRN effectiveness documenting process was ",$S($G(ZTSK):"",1:"NOT"),"queued",!
16 .W !," TASK#: "_$G(ZTSK)
17 Q
18PSBPRNS ;Document all administrations of a PRN order that have NOT had
19 ; the PRN Effectiveness documented for dates user provided
20 ;
21 N PSBIEN
22 I $G(DUZ)="" W !,"Your DUZ is not defined. It must be defined." Q
23 S PSBDUZ=$G(DUZ)
24 D HEADER
25 ;get start date
26 S %DT="AEQ",%DT("A")="Select Date to Process From: "
27 S %DT("B")=""
28 W ! D ^%DT Q:+Y<1 S PSBDT=Y
29 S PSBPRNDT=PSBDT D D^DIQ
30 ;Get stop date
31 S %DT="AEQ",%DT("A")="Select Date to Process Up to: "
32 S %DT("B")=""
33 W ! D ^%DT Q:+Y<1 S PSBDTA=Y
34 S PSBSTRTE=PSBDTA D D^DIQ
35 I PSBPRNDT>PSBSTRTE W !,"Start date cannot be greater than end date" Q
36 ;Write user running routine
37 S PSBNAME=$P(^VA(200,PSBDUZ,0),"^",1)
38 W !!,"PRN effectiveness entered by: ",PSBNAME,!
39 D HEADER
40 ;COMMIT OR QUIT
41 S Y=PSBDTA D DD^%DT S PSBRDT=Y
42 S Y=PSBPRNDT D DD^%DT S PSBRDTA=Y
43 W !!!,?10,"**PRN DOCUMENTATION WILL BE FILED FOR THE FOLLOWING**"
44 W !!,?5,"PRN START DATE...........: ",PSBRDTA
45 W !,?5,"PRN END DATE.............: ",PSBRDT
46 W !,?5,"PRN ENTERED BY...........: ",PSBNAME
47 W !,?5,"PRN DOCUMENTATION STATEMENT: "
48 ;Set mesage to be used
49 S PSBPRNM="Administrative Closure"
50 I $L(PSBPRNM)>0 D
51 .W ?9,$E(PSBPRNM,1,52)
52 R !!,"Would you like to CONTINUE ? (Y/N):",PSBANS:30
53 S PSBFLAG=""
54 I (PSBANS["Y")!(PSBANS="y") S PSBFLAG=1
55 I PSBFLAG'=1 D Q
56 .W !!,"You have chosen not to continue! Application ending!!"
57 D HEADER
58 D ENV(PSBPRNDT,PSBSTRTE,PSBDUZ,PSBPRNM)
59 Q
60 ;
61PROCESS(PSBPRNDT,PSBSTRTE,PSBDUZ,PSBPRNM) ;
62 ;Gather Patient DFN
63 S PSBSRTD=PSBSTRTE+1
64 S PSBPRTA=PSBPRNDT-1
65 S PSBCNT="0"
66 S DFN="" F S DFN=$O(^PSB(53.79,"APRN",DFN)) Q:DFN="" D
67 .S PSBSTRT="" F S PSBSTRT=$O(^PSB(53.79,"APRN",DFN,PSBSTRT)) Q:PSBSTRT="" D
68 ..I PSBSTRT>PSBPRTA,PSBSTRT<PSBSRTD D
69 ...S PSBIEN="" F S PSBIEN=$O(^PSB(53.79,"APRN",DFN,PSBSTRT,PSBIEN)) Q:'PSBIEN D
70 ....I ($P(^PSB(53.79,PSBIEN,0),U,9)'="G")&($P(^PSB(53.79,PSBIEN,0),U,9)'="RM") Q ;Med was never given
71 ....Q:$P($G(^PSB(53.79,PSBIEN,.2)),U,2)]"" ;PRN already entered
72 ....D FILEIT(PSBIEN,PSBPRNM)
73 ....;increment counter
74 ....S PSBCNT=PSBCNT+1
75 ;Email the results
76 D PSBEMAIL(PSBCNT,PSBPRNM,PSBSTRTE,PSBPRNDT,PSBDUZ)
77 K PSBCNT,PSBPRNM,PSBDTA,PSBPRNDT,PSBDUZ,PSBPRMG,PSBSTRTE
78 K PSBSRTD,PSBPRTA
79 Q
80 ;File PRN
81FILEIT(PSBIEN,PSBPRNM) ;
82 ;
83 S PSBREC(0)=PSBPRNM
84 S PSBIEN=PSBIEN_","
85 D VAL^PSBML(53.79,PSBIEN,.22,PSBREC(0))
86 D FILEIT^PSBML
87 Q
88 ;
89 ;
90HEADER ;Header
91 W #
92 W !,$TR($J("",IOM)," ","-")
93 W !,?23,"PRN EFFECTIVENESS DOCUMENTATION ROUTINE"
94 W !,$TR($J("",IOM)," ","-")
95 Q
96 ;
97 ;
98PSBEMAIL(PSB1,PSB2,PSB3,PSB4,PSB5) ;
99 ; PSB1 = PRN Count
100 ; PSB2 = PRN message to file
101 ; PSB3 = START date for search
102 ; PSB4 = FINISH date for search
103 ; PSB5 = DUZ for PRN entered by
104 ; Send PRN documentation changes to user
105 S Y=PSB3 D DD^%DT S PSB3X=Y
106 S Y=PSB4 D DD^%DT S PSB4X=Y
107 S PSB5=$P(^VA(200,PSB5,0),"^",1)
108 S PSBMG=DUZ ;
109 Q:PSBMG=""
110 S PSBMSG(1)=" "
111 S PSBMSG(2)=" PRN effectiveness not documented have been fixed. "
112 S PSBMSG(3)=" "
113 S PSBMSG(4)=" PRN effectiveness entered by.: "_PSB5
114 S PSBMSG(5)=" Number of PRNs documented....: "_PSB1
115 S PSBMSG(6)=" Start Date.......: "_PSB4X
116 S PSBMSG(7)=" Finish Date......: "_PSB3X
117 S PSBMSG(8)=" Message documented for PRNs..: "_PSB2
118 S PSBMSG(9)=" "
119 S PSBMSG(10)=" "
120 S PSBMSG(11)=" "
121 S PSBMSG(12)=""
122 S PSBMSG(13)=" "
123 S PSBMSG(14)=" "
124 S PSBMSG(15)=" "
125 S XMY(DUZ)="",XMTEXT="PSBMSG(",XMSUB="BCMA PRN DOCUMENTATION Notification."
126 D ^XMD
127 K PSB1,PSB2,PSB3,PSB4,PSB5,PSB4X,PSB3X
128 K PSBMSG,PSBMG,XMY,XMSUB,XMTEXT
129 Q
130 ;
131 ;
132 ;
133 ;
134 ;
Note: See TracBrowser for help on using the repository browser.