source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJFTR.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1PSJFTR ;BIR/JCH-INPATIENT MEDS FREE TEXT DOSAGE REPORT ;15 Nov 01 / 9:45 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**65,73,76,111**;16 Dec 97
3 ;
4 ; Reference to ^PSDRUG is supported by DBIA 2192.
5 ; Reference to ^PS(55 is supported by DBIA 2191.
6 ; Reference to ^PSSORPH is supported by DBIA 3234.
7 ;
8 ;List IP orders that have free text dosages for a given date range.
9 ;Report is sorted by drug and physician.
10 ;
11BEG ;Begin
12 N BEGDT,ENDT
13 W !,"This report searches for Free Text Dosages in Inpatient Unit Dose Orders"
14 W !,"for a range of dates. Orders with Stop Dates that fall within the range"
15 W !,"are included in the report."
16 W ! K %DT S %DT("A")="Beginning Date: ",%DT="APE"
17 D ^%DT G:Y<0!($D(DTOUT)) EXIT S (%DT(0),BEGDT)=Y
18 W ! S %DT("A")="Ending Date: "
19 D ^%DT G:Y<0!($D(DTOUT)) EXIT S ENDT=Y D:+$E(Y,6,7)=0 DTC
20 K %DT(0)
21 ;
22DEV ;Device
23 K %ZIS,IOP,POP,ZTSK S PSJION=$I,%ZIS="QM"
24 D ^%ZIS K %ZIS
25 I POP S IOP=PSJION D ^%ZIS K IOP,PSJION W !,"Please try later!" G EXIT
26 K PSJION I $D(IO("Q")) D G EXIT
27 .S ZTDESC="Rx free text dosage report",ZTRTN="START^PSJFTR"
28 .F G="BEGDT","ENDT" S:$D(@G) ZTSAVE(G)=""
29 .K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print!" K ZTSK
30START ;Start processing date range
31 N PSGND0,PSGDT,PSGORD,PSJDOSE,PSGDRG,PSJDRN,PSJPR,PSJCNT
32 N PSJL,PSJY,PSJC,STOPDT,DRGNODE,STDT
33 K ^TMP("PSJFTR",$J)
34 S Q=0 W:$E(IOST)="C" !!!,"Working - please wait.."
35UD ;
36ST1 ;
37 S PSGDFN=0,STOPDT=ENDT_".99999"
38 F S PSGDFN=$O(^PS(55,PSGDFN)) Q:'PSGDFN!$D(DIRUT) D
39 .S STDT=BEGDT-.0001
40 .F S STDT=$O(^PS(55,PSGDFN,5,"AUS",STDT)) Q:'STDT!(STDT>STOPDT)!$D(DIRUT) D
41 ..S PSGORD="" I PSGDFN=740 S JCH=$G(JCH)+1
42 ..F S PSGORD=$O(^PS(55,PSGDFN,5,"AUS",STDT,PSGORD)) Q:PSGORD=""!$D(DIRUT) D
43 ...Q:'$D(^PS(55,PSGDFN,5,PSGORD,1,0))
44 ...S PSGDCNT=0 F S PSGDCNT=$O(^PS(55,PSGDFN,5,PSGORD,1,PSGDCNT)) Q:'PSGDCNT D
45 ....N PKG,LOCNOD,ORDOSE,FMDOSE,FMUNIT,NOTXT,NXT,DARRAY,POSDOSE,LOCDOSE
46 ....S NOTXT=0
47 ....S PSGDRG=+$G(^PS(55,PSGDFN,5,PSGORD,1,PSGDCNT,0))
48 ....Q:'$D(^PSDRUG(PSGDRG))!'PSGDRG
49 ....S DRGNODE=$G(^PS(55,PSGDFN,5,PSGORD,.2)),PSGND0=^PS(55,PSGDFN,5,PSGORD,0)
50 ....S FMDOSE=$P(DRGNODE,"^",5),FMUNIT=$P(DRGNODE,"^",6)
51 ....I FMDOSE]"",FMUNIT]"" Q
52 ....S ORDOSE=$P(DRGNODE,"^",2) Q:ORDOSE="" ; Nothing there?
53 ....I $E(IOST)="C" S Q=Q+1 W:'(Q#50) "."
54 ....K DARRAY S DARRAY="" D DOSE^PSSORPH(.DARRAY,PSGDRG,"U")
55 ....I '$G(DARRAY(1)) D CHKLOC ; check local doses
56 ....I $G(DARRAY(1)) D CHKPOS ; check possible doses
57 ....Q:NOTXT ; Not free text
58 ....D PRD
59 U IO S PSJPG=1,PSJCNT=0 D HD
60 I '$D(^TMP("PSJFTR",$J,"B")) W !!,"***** No Records were found for this period *****",!! G EXIT
61DET ;
62 S J="" F S J=$O(^TMP("PSJFTR",$J,"B",J)) Q:J="" D Q:$D(DIRUT)
63 .S L="",Q=0,Q2=0
64 .F S L=$O(^TMP("PSJFTR",$J,"B",J,L)) Q:L="" D Q:$D(DIRUT)
65 ..S PSGDRG=$O(^TMP("PSJFTR",$J,"B",J,L,0))
66 ..Q:'PSGDRG
67 ..S Y=^TMP("PSJFTR",$J,"B",J,L,PSGDRG,0)
68 ..W:'Q !,$E(J,1,30)_" ("_PSGDRG_")"
69 ..W:Q2'=Q !,$E(J,1,30)_" ("_PSGDRG_")"," - (Continued)",!
70 ..W:$L(L)>35 ?40,$E(L,1,35),!,?40,$E(L,36,99) W:$L(L)'>35 ?40,L
71 ..W ?75,+Y,!," "
72 ..S Q=Q+1,Q2=Q
73 ..S PR=0 F S PR=$O(^TMP("PSJFTR",$J,"B",J,L,PSGDRG,PR)) Q:'PR D
74 ...S Y=^TMP("PSJFTR",$J,"B",J,L,PSGDRG,PR),T=$S(PR=.1:"PROVIDER NOT FOUND",1:$P(^VA(200,+PR,0),"^"))
75 ...S T=T_":"_Y_" "
76 ...W:($X+$L(T))>74 !?4
77 ...W T
78 ..W ! I ($Y+5)>IOSL D HD S Q2=0
79EXIT W ! D ^%ZISC K DIR,DTOUT,DUOUT,DIROUT,DIRUT,^TMP("PSJFTR",$J),I,X,T,J,L,Q,Y
80 S:$D(ZTQUEUED) ZTREQ="@"
81 Q
82PRD ;
83 S PSJDRN=$P(^PSDRUG(PSGDRG,0),"^"),PSJPR=+$P(PSGND0,"^",2)
84 I 'PSJPR S PSJPR=.1
85 I '$D(^TMP("PSJFTR",$J,"B",PSJDRN,ORDOSE,PSGDRG,PSJPR)) D Q
86 .S ^TMP("PSJFTR",$J,"B",PSJDRN,ORDOSE,PSGDRG,PSJPR)=1
87 .S ^TMP("PSJFTR",$J,"B",PSJDRN,ORDOSE,PSGDRG,0)=$G(^TMP("PSJFTR",$J,"B",PSJDRN,ORDOSE,PSGDRG,0))+1
88 I $D(^TMP("PSJFTR",$J,"B",PSJDRN,ORDOSE,PSGDRG,PSJPR)) D Q
89 .S Y=^TMP("PSJFTR",$J,"B",PSJDRN,ORDOSE,PSGDRG,PSJPR)
90 .S Y=Y+1,^TMP("PSJFTR",$J,"B",PSJDRN,ORDOSE,PSGDRG,PSJPR)=Y
91 .S X=^TMP("PSJFTR",$J,"B",PSJDRN,ORDOSE,PSGDRG,0)
92 .S X=X+1,^TMP("PSJFTR",$J,"B",PSJDRN,ORDOSE,PSGDRG,0)=X
93 Q
94 ;
95CHKPOS ; Check for possible doses
96 S NOTXT=0
97 S NXT="" F S NXT=$O(DARRAY(NXT)) Q:'NXT!NOTXT D
98 .Q:$P($G(^PSDRUG(PSGDRG,"DOS1",NXT,0)),"^",3)'["I"
99 .S POSDOSE=$P(DARRAY(NXT),"^",1)_$P(DARRAY(NXT),"^",2) I POSDOSE=ORDOSE S NOTXT=1
100 Q
101 ;
102CHKLOC ; Check for local doses
103 S NOTXT=0
104 S NXT="" F S NXT=$O(DARRAY(NXT)) Q:'NXT!NOTXT D
105 .Q:$P($G(^PSDRUG(PSGDRG,"DOS2",NXT,0)),"^",2)'["I"
106 .S LOCDOSE=$P(DARRAY(NXT),"^",3) I LOCDOSE=ORDOSE S NOTXT=1
107 Q
108 ;
109HD ;
110 I PSJPG>1,$E(IOST)="C" S DIR(0)="E",DIR("A")=" Press Return to Continue or ^ to Exit" D ^DIR K DIR
111 Q:$D(DIRUT)
112 N FMTDT
113 I PSJPG=1,$E(IOST)="C" W @IOF
114 I PSJPG>1 W @IOF W "Run Date: " S FMTDT=$$FMTE^XLFDT(DT) W FMTDT
115 W ?72,"Page "_PSJPG S PSJPG=PSJPG+1
116 W !,?15,"Inpatient Free Text Dosage Entry Report",!,?17,"Period: "
117 S FMTDT=$$FMTE^XLFDT(BEGDT) W FMTDT W " to "
118 S FMTDT=$$FMTE^XLFDT(ENDT) W FMTDT
119 W !,"Drug",?40,"Free Text Entry",?74,"Count",!," Provider:Count"
120 W ! F Y=1:1:79 W "-"
121 W ! Q
122DTC ;
123 N DD,MM S DD=31,MM=+$E(Y,4,5) I MM'=12 S MM=MM+1,MM=$S(MM<10:"0",1:"")_MM,X2=Y,X1=$E(Y,1,3)_MM_"00" D ^%DTC S DD=X
124 S ENDT=Y+DD
125 Q
Note: See TracBrowser for help on using the repository browser.