source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGEUDD.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1PSGEUDD ;BIR/MV-EXTRA UNITS DISPENSED REPORT ;14 JAN 97 / 9:22 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**27,31,59,111**;16 DEC 97
3 ;
4 ; Reference to ^PS(55 is supported by DBIA# 2191
5 ; Reference to ^DIC(42 is supported by DBIA# 10039
6 ;
7NEW ;***New needed variables.
8 K ^TMP($J)
9 NEW AMT,DRG,ND,NO,PPN,TM,WHO,XDESC,XSAVE,XTRTN,PSJACNWP
10 ;
11ASK ;***Ask for date range and output device
12 Q:$$STDATE^PSJMDIR S PSGSDT=Y
13 K DIR S DIR(0)="DAO^"_PSGSDT_"::,EXAR",DIR("A")="Enter Ending Date and Time: ",DIR("?")="Please enter a date and time that is greater than the Start Date" D ^DIR S PSGEDT=Y Q:$$STOP^PSJMDIR
14 Q:$$GWP^PSJMDIR1(0)
15 Q:$$SELDEV^PSJMUTL
16 W:'$D(IO("Q")) !,"this may take a while...(you should QUEUE the Extra Units Dispensed report)"
17 ;***Queue to sort in the background.
18 I $D(IO("Q")) D G EXIT
19 . S XDESC="Extra Unit Dose Dispensed (Sort)"
20 . ;Added PSGWGNM to XSAVE to enable printing of ward group total for queued prints
21 . S XSAVE="PSGWGNM;PSGSDT;PSGEDT;PSGSS;PSGIO;PSGWG;PSGWD;PSGWN;PSGTMALL;PSGTM;PSGPAT(;PSGP(;PSGIODOC"
22 . S XTRTN="START^PSGEUDD"
23 . D SETSORTQ^PSJMUTL(XDESC,XSAVE,XTRTN)
24 D START
25 ;
26EXIT ;***Exit report here.
27 D ENKV^PSGSETU
28 D EXIT^PSJMUTL
29 K ^TMP($J),PSGDT,PSGEDT,PSGIO,PSGORD,PSGP,PSGPAT,PSGSDT,PSGSS,PSGTM,PSGTMALL,PSGWD,PSGWG,PSGWGNM,PSGWN,PSJSTOP
30 Q
31START ;***Start queuing here.
32 D @PSGSS
33 ;***Queue to the printer.
34 I $D(PSGIO) D G EXIT
35 . S XDESC="Extra Unit Dose Dispensed (Print)"
36 . S XSAVE="^TMP($J,;PSGWGNM;PSGTMALL;PSGTM;PSGSDT;PSGEDT;PSGSS;PSGIODOC"
37 . S XTRTN="^PSGEUDP"
38 . D SETPRTQ^PSJMUTL(XDESC,XSAVE,XTRTN)
39 D ^PSGEUDP
40 Q
41 ;
42P ;***Select by Patient
43 S PPN="" F S PPN=$O(PSGPAT(PPN)) Q:PPN="" S PSGP=PSGPAT(PPN),PSJACNWP="" K PSJPPID,PSJPRB D ^PSJAC,LOOP
44 Q
45 ;
46C ;***Select by CLINIC
47 N DT,CLIN
48 S TM="ZZ",PSJACNWP=""
49 S DT=PSGSDT F S DT=$O(^PS(55,"AUDC",DT)) Q:DT>PSGEDT!(DT="") S CLIN=0 F S CLIN=$O(^PS(55,"AUDC",DT,CLIN)) Q:'CLIN D
50 .S PSGP=0 F S PSGP=$O(^PS(55,"AUDC",DT,CLIN,PSGP)) Q:'PSGP D ^PSJAC S PPN=PSGP(0) D LOOP
51 Q
52G ;***Select by WARD GROUP
53 D WARDGP
54 Q
55W ;***Select by Ward
56 D WARD
57 Q
58WARDGP ;*** Find wards within a ward group
59 S PSGWD="",TM="ZZ" F S PSGWD=$O(^PS(57.5,"AC",PSGWG,PSGWD)) Q:'PSGWD I $D(^DIC(42,+PSGWD,0)) S PSGWN=$P(^(0),U) D WARD
60 Q
61 ;
62WARD ;*** Go through each patient within a given WARD
63 ;*** Var used in PSJAC. Set to null to skip WP^PSJAC
64 S PSJACNWP=""
65 F PSGP=0:0 S PSGP=$O(^DPT("CN",PSGWN,PSGP)) Q:'PSGP D ^PSJAC S PPN=PSGP(0) D:PSGSS="W" TEAM D:PSGSS="G" LOOP
66 Q
67TEAM ;*** Look up selected team. PSGTMALL= All teams were selected.
68 S TM=""
69 I PSGTMALL D ALLTM,LOOP Q
70 I 'PSGTM S TM="ZZ" D LOOP Q
71 D ALLTM D:$D(PSGTM(TM)) LOOP
72 Q
73 ;
74ALLTM ;*** Get UNIT DOSE information from ^PS(55
75 ;
76 S TM="ZZ"
77 S TM=$S(PSJPRB="":0,1:+$O(^PS(57.7,"AWRT",PSGWD,PSJPRB,0))),TM=$S('TM:"ZZ",'$D(^PS(57.7,PSGWD,1,TM,0)):TM,$P(^(0),U)]"":$P(^(0),U),1:TM)
78 Q
79 ;
80LOOP ;***Loop thru ^PS(55 on the Dispense log multiple.
81 F PSGORD=0:0 S PSGORD=$O(^PS(55,+PSGP,5,PSGORD)) Q:'PSGORD D
82 . S PSGDT=PSGSDT-.000001
83 . F S PSGDT=$O(^PS(55,+PSGP,5,+PSGORD,11,"B",PSGDT)) Q:'PSGDT!(PSGEDT<PSGDT) D
84 ..F NO=0:0 S NO=$O(^PS(55,+PSGP,5,+PSGORD,11,"B",PSGDT,NO)) Q:'NO S ND=^PS(55,+PSGP,5,+PSGORD,11,NO,0) D
85 ...I $P(ND,U,5)=3 S DRG=$$ENDDN^PSGMI($P(ND,U,2)),AMT=$P(ND,U,3),WHO=$P(ND,U,6) D @($S(PSGSS="P":"TMPPT",1:"TMPWG"))
86 Q
87 ;
88TMPWG ;***Set ^TMP global for selected by Ward/Ward Group.
89 S ^TMP($J,PSGWN,TM,DRG,$E(PPN,1,10)_"^"_+PSGP,PSGDT)=AMT_U_WHO_U_PSJPBID
90 Q
91 ;
92TMPPT ;***Set ^TMP global for selected by patient.
93 S ^TMP($J,$E(PPN,1,10)_"^"_+PSGP,DRG,PSGDT)=AMT_U_WHO_U_PSJPPID_U_PSJPRB_U_PSJPWDN
94 Q
Note: See TracBrowser for help on using the repository browser.