source: FOIAVistA/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBOXA.m@ 785

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

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1PSBOXA ;BIRMINGHAM/EFC-MEDICATION LOG ;Mar 2004
2 ;;3.0;BAR CODE MED ADMIN;**13**;Mar 2004
3 ;
4 ; Reference/IA
5 ;
6 ; File 4/10090
7 ;
8 ;
9 ; Entry Point - Report OPTION used by PSB MANAGER key holders to locate
10 ; "UNKNOWN" Action Status entries in the BCMA Medication Log File.
11 ;
12EN ; UNKNOWN Action Status Report - creation!
13 ;
14 S PSBDTST=+$P(PSBRPT(.1),U,6)
15 S PSBDTSP=+$P(PSBRPT(.1),U,8)
16 D NOW^%DTC S Y=% D DD^%DT S PSBDTTM=Y
17 S PSBLIST=""
18 S (PSBPGNUM,PSBLNTOT,PSBTOT,PSBX1)=""
19 F S PSBX1=$O(^PSB(53.79,"AADT",PSBX1)) Q:PSBX1="" D
20 .S PSBX2=$$FMADD^XLFDT(PSBDTST,,,,-.1) F S PSBX2=$O(^PSB(53.79,"AADT",PSBX1,PSBX2)) Q:(PSBX2>$$FMADD^XLFDT(PSBDTSP,,23.9999))!(+PSBX2=0) D
21 ..S PSBX3="" F S PSBX3=$O(^PSB(53.79,"AADT",PSBX1,PSBX2,PSBX3)) Q:+PSBX3=0 D
22 ...Q:('$D(^PSB(53.79,PSBX3,0)))!$D(PSBLIST(PSBX3))
23 ...I $P(^PSB(53.79,PSBX3,0),U,9)="" I $$GET1^DIQ(4,$P(PSBRPT(0),U,4)_",",.01)=$$GET1^DIQ(4,$P(^PSB(53.79,PSBX3,0),U,3)_",",.01) D
24 ....L +^PSB(53.79,PSBX3):1 I L -^PSB(53.79,PSBX3) S PSBTOT=PSBTOT+1,PSBLIST(PSBX3)=""
25 I +PSBTOT=0 K PSBLIST
26 S Y=PSBDTST D DD^%DT S Y1=Y S Y=PSBDTSP D DD^%DT S Y2=Y
27 D BLDRPT
28 D WRTRPT
29 Q
30 ;
31BLDRPT ;
32 ;
33 K PSBOUTP
34 S (PSBPGNUM,PSBX1)=""
35 I '$D(PSBLIST) D Q
36 .S PSBPGNUM=1
37 .S PSBOUTP(0,14)="W !!,""<<<< NO """"UNKNOWN ACTION STATUS"""" ENTRIES FOUND FOR THIS DATE RANGE >>>>"",!!"
38 S PSBPGNUM=1,PSBTOT1=0
39 F S PSBX1=$O(PSBLIST(PSBX1)) Q:+PSBX1=0 D
40 .S PSBTOT1=PSBTOT1+1
41 .D CLEAN^PSBVT,PSJ1^PSBVT($$GET1^DIQ(53.79,PSBX1_",",.01,"I"),$$GET1^DIQ(53.79,PSBX1_",",.11))
42 .S PSBOUTP($$PGTOT,PSBLNTOT)="W """_PSBTOT1_".)"",!,?5,""Action Status...: "_$S($$GET1^DIQ(53.79,PSBX1_",",.09)']"":"*UNKNOWN*",1:$$GET1^DIQ(53.79,PSBX1_",",.09))_""""
43 .S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Patient.........: ("_$$GET1^DIQ(2,PSBDFN_",",.09)_") "_$$GET1^DIQ(2,PSBDFN_",",.01)_""""
44 .S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Ward/Bed........: "_$$GET1^DIQ(2,PSBDFN_",",.1)_$S($$GET1^DIQ(2,PSBDFN_",",.101)']"":"",1:"/"_$$GET1^DIQ(2,PSBDFN_",",.101))_""""
45 .S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Order Number....: "_PSBONX_""""
46 .S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Orderable Item..: "_PSBOITX_""""
47 .S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Schedule........: "_PSBSCH_""""
48 .S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Scheduled Adm Tm: "_$S($$GET1^DIQ(53.79,PSBX1_",",.13)']"":"AS NEEDED",1:$$GET1^DIQ(53.79,PSBX1_",",.13))_""""
49 .S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Created Dt/Tm...: "_$$GET1^DIQ(53.79,PSBX1_",",.06)_""""
50 .S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Created By......: ("_$$GET1^DIQ(53.79,PSBX1_",",.07,"I")_") "_$$GET1^DIQ(53.79,PSBX1_",",.07)_""""
51 .S PSBOUTP($$PGTOT(3),PSBLNTOT)="W !,$TR($J("""",IOM),"" "",""-""),!!"
52 Q
53 ;
54WRTRPT ; Actually "WRITE" the report to output device
55 ;
56 I $O(PSBOUTP(""),-1)<1 D Q
57 .D HDR
58 .X PSBOUTP($O(PSBOUTP(""),-1),14)
59 .D FTR
60 S PSBPGNUM=1
61 D HDR
62 S PSBX1="" F S PSBX1=$O(PSBOUTP(PSBX1)) Q:PSBX1="" D
63 .I PSBPGNUM'=PSBX1 D FTR S PSBPGNUM=PSBX1 D HDR
64 .S PSBX2="" F S PSBX2=$O(PSBOUTP(PSBX1,PSBX2)) Q:PSBX2="" D
65 ..X PSBOUTP(PSBX1,PSBX2)
66 D FTR
67 Q
68 ;
69HDR ; Create Report Header
70 ;
71 ;
72 ; BAR CODE MEDICATION ADMINISTRATION (BCMA) UNKNOWN ACTION STATUS REPORT
73 ; Date/Time: NOW
74 ; Date Range: Y1 to Y2 (inculsive)
75 ;
76 ;
77 ; This is a report of entries, created within the given date range, in the
78 ; BCMA Medication Log File with UNKNOWN Action Status data.
79 ; These entries may be corrected via the BCMA GUI "Edit Med Log".
80 ;
81 ;----------------------------------------------------------------
82 ;
83 W:$Y>1 @IOF
84 W:$X>1 !
85 S PSBPG="Page: "_PSBPGNUM_" of "_$S($O(PSBOUTP(""),-1)=0:1,1:$O(PSBOUTP(""),-1))
86 S PSBPGRM=IOM-($L(PSBPG)+5)
87 I $P(PSBRPT(0),U,4)="" S $P(PSBRPT(0),U,4)=DUZ(2)
88 S PSBDIVN="Division: "_$$GET1^DIQ(4,$P(PSBRPT(0),U,4)_",",.01)
89 W !!,"BCMA UNKNOWN ACTION STATUS REPORT" W ?PSBPGRM,PSBPG
90 W !,"Date/Time: "_PSBDTTM,!,"Report Date Range: Start Date: "_Y1_" Stop Date: "_Y2
91 W !,PSBDIVN,?(IOM-($L("Total *UNKNOWN* entries found: "_+PSBTOT)+5)),"Total *UNKNOWN* entries found: "_+PSBTOT
92 W !!,?5,"This is a report of entries, created within the given date range,"
93 W !,?5,"in the BCMA Medication Log File with UNKNOWN Action Status data."
94 W !,?5,"These entries can be corrected using the BCMA GUI ""Edit Med Log""."
95 W !!,$TR($J("",IOM)," ","="),!!
96 ;
97 Q
98 ;
99FTR ; Create Report Footer
100 ;
101 I (IOSL<100) F Q:$Y>(IOSL-7) W !
102 W !,$TR($J("",IOM)," ","="),!
103 W !,PSBDTTM,!,"BCMA UNKNOWN ACTION STATUS REPORT - footer -"
104 W ?PSBPGRM,PSBPG,!
105 Q
106 ;
107PGTOT(X) ;Keep track of lines and PAGE Number...
108 ;
109 S:'$D(X) PSBLNTOT=PSBLNTOT+1
110 S:$D(X) PSBLNTOT=PSBLNTOT+X
111 I PSBPGNUM=1,(PSBLNTOT=1) S PSBLNTOT=14 S PSBMORE=PSBLNTOT+12 Q PSBPGNUM
112 I PSBLNTOT=PSBMORE D
113 .S PSBMORE=PSBLNTOT+12
114 .I PSBMORE>(IOSL-7) S PSBPGNUM=PSBPGNUM+1,PSBLNTOT=14 S PSBMORE=PSBLNTOT+12
115 Q PSBPGNUM
Note: See TracBrowser for help on using the repository browser.