source: FOIAVistA/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBOMD.m@ 1783

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1PSBOMD ;BIRMINGHAM/EFC-MISSING DOSE REPORT ;Mar 2004
2 ;;3.0;BAR CODE MED ADMIN;;Mar 2004
3 ;
4 ; Reference/IA
5 ; WARD^NURSUT5/3052
6 ; IN5^VADPT/10061
7 ; $$GET1^DIQ(52.6/436
8 ; $$GET1^DIQ(52.7/437
9 ;
10EN ; Begin printing
11 N PSBSCHD,PSBWRD,PSBSTRT,PSBSTOP,PSBWARD,PSBDRUG,PSBDT,PSBIEN,PSBWRDA
12 K ^TMP("PSB",$J)
13 S PSBWRD=+$P(PSBRPT(.1),U,3)
14 I PSBWRD D WARD^NURSUT5("L^"_PSBWRD,.PSBWRDA) S X="" F S X=$O(PSBWRDA(PSBWRD,2,X)) Q:X="" S Y=PSBWRDA(PSBWRD,2,X,.01),PSBWRD(+Y)=$P(Y,U,2),^TMP("PSB",$J,PSBWRD(+Y))=0
15 S PSBSTRT=$P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,7)
16 S PSBSTOP=$P(PSBRPT(.1),U,8)+$P(PSBRPT(.1),U,9)
17 S PSBDT=PSBSTRT-.0000001
18 F S PSBDT=$O(^PSB(53.68,"ADTE",PSBDT)) Q:'PSBDT!(PSBDT>PSBSTOP) D
19 .S PSBIEN=0
20 .F S PSBIEN=$O(^PSB(53.68,"ADTE",PSBDT,PSBIEN)) Q:'PSBIEN D
21 ..Q:PSBWRD&('$D(PSBWRD(+$P($G(^PSB(53.68,PSBIEN,.1)),U,2))))
22 ..S PSBWARD=$$GET1^DIQ(53.68,PSBIEN_",",.12) Q:PSBWARD=""
23 ..S PSBDRUG=$$GET1^DIQ(53.68,PSBIEN_",",.13) I PSBDRUG="" D
24 ...S PSBDRUG="NO DATA"
25 ...I $D(^PSB(53.68,PSBIEN,.6)) S X=0 F S X=$O(^PSB(53.68,+PSBIEN,.6,X)) Q:'X S PSBDRUG=$$GET1^DIQ(52.6,+^PSB(53.68,PSBIEN,.6,X,0),.01)
26 ...I $D(^PSB(53.68,PSBIEN,.7)) S X=0 F S X=$O(^PSB(53.68,+PSBIEN,.7,X)) Q:'X S PSBDRUG=PSBDRUG_" "_$$GET1^DIQ(52.7,+^PSB(53.68,+PSBIEN,.7,X,0),.01)
27 ..S PSBSCHD=$$GET1^DIQ(53.68,PSBIEN_",",.19) S:PSBSCHD="" PSBSCHD="NO DATA"
28 ..S ^TMP("PSB",$J,PSBWARD,PSBDRUG,PSBSCHD)=$G(^TMP("PSB",$J,PSBWARD,PSBDRUG,PSBSCHD))+1
29 ..S ^TMP("PSB",$J,PSBWARD)=+$G(^TMP("PSB",$J,PSBWARD))+1
30 ..S ^TMP("PSB",$J)=+$G(^TMP("PSB",$J))+1
31 W $$HDR()
32 I '$D(^TMP("PSB",$J)) W !!?5,"<<<NO MISSING DOSE REQUESTS FOR THIS TIME FRAME>>>" Q
33 S PSBWARD=""
34 F S PSBWARD=$O(^TMP("PSB",$J,PSBWARD)) Q:PSBWARD="" D
35 .W:$Y>(IOSL-10) $$HDR()
36 .W !,PSBWARD
37 .S (PSBDRUG,PSBSCHD)=""
38 .F S PSBDRUG=$O(^TMP("PSB",$J,PSBWARD,PSBDRUG)) Q:PSBDRUG="" D
39 ..F S PSBSCHD=$O(^TMP("PSB",$J,PSBWARD,PSBDRUG,PSBSCHD)) Q:PSBSCHD="" D
40 ...W:$Y>(IOSL-10) $$HDR()
41 ...W ?32,PSBDRUG,?74,$J(+^TMP("PSB",$J,PSBWARD,PSBDRUG,PSBSCHD),8),!,?35,"Schedule: "_PSBSCHD,!
42 .W ?74,"--------"
43 .W !?32,"Ward ",PSBWARD," Total: ",?74,$J(^TMP("PSB",$J,PSBWARD),8),!
44 W ?74,"========"
45 W !?32,"Report Total: ",?74,$J(+$G(^TMP("PSB",$J)),8)
46 K ^TMP("PSB",$J)
47 Q
48 ;
49HDR() ;
50 I '$D(PSBRPT("DATE")) D NOW^%DTC S Y=+$E(%,1,12) D D^DIQ S PSBRPT("DATE")="Run Date: "_Y
51 S:'$D(PSBRPT("PAGE")) PSBRPT("PAGE")=1
52 W:$Y>1 @IOF
53 W !,$TR($J("",IOM)," ","="),!,"MISSING DOSE REPORT FROM "
54 S Y=PSBSTRT D D^DIQ W Y," thru "
55 S Y=PSBSTOP D D^DIQ W Y
56 W ?(IOM-$L(PSBRPT("DATE"))),PSBRPT("DATE"),!,$S(PSBWRD:"SELECTED",1:"ALL")," WARDS"
57 S X="Page: "_PSBRPT("PAGE")
58 W ?(IOM-$L(X)),X
59 S PSBRPT("PAGE")=PSBRPT("PAGE")+1
60 W !,$TR($J("",IOM)," ","="),!,"Ward Location",?32,"Medication",?77,"Total",!,$TR($J("",IOM)," ","-"),!
61 Q ""
62 ;
63POST ;
64 N DFN
65 S DFN=X D IN5^VADPT
66 S PSBDDSW=$P(VAIP(5),U,2)
67 S PSBDDSR=$P(VAIP(6),U,2)
68 Q
Note: See TracBrowser for help on using the repository browser.