source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJMPRT.m@ 1258

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

initial load of WorldVistAEHR
File size: 3.5 KB
RevLine 
[613]1PSJMPRT ;BIR/MV-PRINT DRIVE FOR MDWS ;13 FEB 96 / 10:06 AM
2 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
3 ;Loop thru TMP global to print report
4 ;
5INIT ;
6 Q:'$D(^TMP($J)) U IO
7 NEW DRG,ND,PID,PID1,PPN,PPN1,PPNO,PRB,PRB1,PRBO,QST,TM,TM1,TMO,UD0,UD2,XNAME
8 S PSJHL1="MEDICATIONS DUE WORKSHEET For: "
9 S PSJHL2="Report from: "_$$ENDTC^PSGMI(PSGPLS)_" to: "_$$ENDTC^PSGMI(PSGPLF)_" "_"Report Date: "_$E($$ENDTC^PSGMI(DT),1,8)
10 S XNAME="" S:PSGMTYPE[1 XNAME="ALL MEDS"
11 S:PSGMTYPE[2 XNAME="NON-IV MEDs"
12 I PSGMTYPE[3 S:XNAME]"" XNAME=XNAME_", " S XNAME=XNAME_"IVPB"
13 I PSGMTYPE[4 S:XNAME]"" XNAME=XNAME_", " S XNAME=XNAME_"LVPs"
14 I PSGMTYPE[5 S:XNAME]"" XNAME=XNAME_", " S XNAME=XNAME_"TPNs"
15 I PSGMTYPE[6 S:XNAME]"" XNAME=XNAME_", " S XNAME=XNAME_"CHEMO (IV)"
16 S PSJHL3="Continuous/One time Orders for: "_XNAME
17 S PSJHL62="* Projected admin. times based on order's volume, flow rate, and start time."
18 S (PSGPG,PSJNEED,PSJLN,PSJADTO,PSJATMEO)=0,(PPNO,PRBO,TMO)=""
19 S (PPN,QST,DRG,TM,PSJPRB)="",PSJTOTLN=$S($E(IOST)="C":23,1:62)
20 D @PSGSS
21 I PSGPG,$G(PSJASTR) D
22 . S X=$Y F X=X:1:PSJTOTLN W !
23 . W !,PSJHL62 S PSJASTR=0
24 Q
25 ;
26P ;***Selected by Patients.
27 F PSJADT=0:0 S PSJADT=$O(^TMP($J,PSJADT)) Q:'PSJADT F S PPN=$O(^TMP($J,PSJADT,PPN)) Q:PPN="" D
28 . S PSJHL1=$P(PSJHL1,":")_": "_$P(PPN,U)
29 . F PSJATME=0:0 S PSJATME=$O(^TMP($J,PSJADT,PPN,PSJATME)) Q:'PSJATME F S QST=$O(^TMP($J,PSJADT,PPN,PSJATME,QST)) Q:QST="" D
30 . . F S DRG=$O(^TMP($J,PSJADT,PPN,PSJATME,QST,DRG)) Q:DRG="" D:'$G(PSJSTOP) PRT
31 Q
32 ;
33G ;***Selected by Ward Group.
34 S PSJHL1=PSJHL1_PSGWGNM
35 ;
36W ;***Selected by Ward.
37 S:PSGSS="W" PSJHL1=PSJHL1_PSGWN
38 F PSJADT=0:0 S PSJADT=$O(^TMP($J,PSJADT)) Q:'PSJADT F S TM=$O(^TMP($J,PSJADT,TM)) Q:TM="" D @("W"_PSGRBADM)
39 Q
40 ;
41WA ;*** Selected by Ward and sort by Admin. time.
42 F PSJATME=0:0 S PSJATME=$O(^TMP($J,PSJADT,TM,PSJATME)) Q:'PSJATME F S PSJPRB=$O(^TMP($J,PSJADT,TM,PSJATME,PSJPRB)) Q:PSJPRB="" D
43 . F S PPN=$O(^TMP($J,PSJADT,TM,PSJATME,PSJPRB,PPN)) Q:PPN="" F S QST=$O(^TMP($J,PSJADT,TM,PSJATME,PSJPRB,PPN,QST)) Q:QST="" D
44 . .F S DRG=$O(^TMP($J,PSJADT,TM,PSJATME,PSJPRB,PPN,QST,DRG)) Q:DRG="" D:'$G(PSJSTOP) PRT
45 Q
46 ;
47WP ;*** Selected by Ward and sort by Patients.
48 F S PPN=$O(^TMP($J,PSJADT,TM,PPN)) Q:PPN="" F PSJATME=0:0 S PSJATME=$O(^TMP($J,PSJADT,TM,PPN,PSJATME)) Q:'PSJATME D
49 . F S QST=$O(^TMP($J,PSJADT,TM,PPN,PSJATME,QST)) Q:QST="" F S DRG=$O(^TMP($J,PSJADT,TM,PPN,PSJATME,QST,DRG)) Q:DRG="" D
50 . . D:'$G(PSJSTOP) PRT
51 Q
52 ;
53WR ;*** Selected by Ward and sort by Room-Bed.
54 F S PSJPRB=$O(^TMP($J,PSJADT,TM,PSJPRB)) Q:PSJPRB="" F S PPN=$O(^TMP($J,PSJADT,TM,PSJPRB,PPN)) Q:PPN="" D
55 . F PSJATME=0:0 S PSJATME=$O(^TMP($J,PSJADT,TM,PSJPRB,PPN,PSJATME)) Q:'PSJATME F S QST=$O(^TMP($J,PSJADT,TM,PSJPRB,PPN,PSJATME,QST)) Q:QST="" D
56 . . F S DRG=$O(^TMP($J,PSJADT,TM,PSJPRB,PPN,PSJATME,QST,DRG)) Q:DRG="" D:'$G(PSJSTOP) PRT
57 Q
58 ;
59PRT ;
60 S ND=^(DRG),PSGP=+ND,ON=$P(ND,U,2),PID=$P(ND,U,3),PSGWN=$S(PSGSS="W":"",1:$P(ND,U,4)),PRB=$P(ND,U,5)
61 I QST["V" D PRT^PSJMIV Q
62 S ND=^TMP($J,QST,PSGP,ON),PSJDOS=$P(ND,U),PSJMR=$P(ND,U,2),PSJSCHE=$P(ND,U,3),PSJHOLD=$S($P(ND,U,4):1,1:0)
63 S PSGLOD=$E($$ENDTC^PSGMI($P(ND,U,5)),1,5)
64 I QST'["Z" S X=$$ENDTC^PSGMI($P(ND,U,6)),PSGLSD=$E(X,1,5)_$E(X,9,15),PSGLFD=$$ENDTC^PSGMI($P(ND,U,7))
65 S PSJONETM=$S(QST="O":1,1:0),PSJONCAL=$S(QST="OA":1,1:0)
66 S PSJSI=$$ENSET^PSGSICHK(^TMP($J,QST,PSGP,ON,1))
67 NEW MARX
68 D DRGDISP^PSJLMUT1(PSGP,+ON_$S(QST["Z":"P",1:"U"),40,0,.MARX,1)
69 S PSJNEED=$S($D(MARX(2)):2,1:1)
70 S X=$L(PSJSI)/41,X=$P(X,".")+($P(X,".",2)>0)
71 S PSJNEED=PSJNEED+X+5+PSJHOLD+PSJONETM+PSJONCAL
72 D ^PSJMPRTU,PRT^PSJMPRTU
73 Q
Note: See TracBrowser for help on using the repository browser.