source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSONVAR1.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: 6.8 KB
Line 
1PSONVAR1 ;BHM/MFR - Non-VA Med Usage Report ;04/10/03
2 ;;7.0;OUTPATIENT PHARMACY;**132,118**;13 Feb 97
3 ;External reference to File ^PS(55 supported by DBIA 2228
4 ;External reference to $$GET1^DIQ is supported by DBIA 2056
5 ;External reference to ^VADPT is supported by DBIA 10061
6 ;External reference to ^XLFDT is supported by DBIA 10103
7 ;External reference to ^%ZISC is supported by DBIA 10089
8 ;
9EN N DATE,DFN,ORD,PAG,PCNT,PRTD,OINAM,PNAM,I,J,Y,X,C,XX,S1,S2,S3,S4,S5,OCNT
10 N OCK,OK,STS,SUB,SP1,SP2,SPF
11 ;
12 U IO K ^TMP("PSONV",$J),^TMP("PSOCNT",$J)
13 S SPF=0,(SP1,SP2)="",$P(SP1,"=",80)="",$P(SP2,"-",80)=""
14 ;
15 ; - Loop through the Non-VA Med orders x-reference
16 S DATE=PSOSD,(DFN,ORD)="",(PCNT,OCNT,PRTD)=0 K DIRUT
17DATE S DATE=$O(^PS(55,"ADCDT",DATE)) G NEXT:DATE=""!(DATE>PSOED)
18 W:SPF SP1
19 ;
20DFN I PSOAPT S DFN=$O(^PS(55,"ADCDT",DATE,DFN)) G DATE:DFN=""
21 I 'PSOAPT S DFN=$O(PSOPT(DFN)) G DATE:DFN="" ;Patient Filter
22 ;
23 I $$DEAD^PSONVARP(DFN) G DFN ;Patient is Dead
24 ;
25ORD S ORD=$O(^PS(55,"ADCDT",DATE,DFN,ORD)) G DFN:ORD=""
26 S XX=$G(^PS(55,DFN,"NVA",ORD,0))
27 I 'PSOAOI,'$D(PSOOI(+$P(XX,"^"))) G ORD ;OI Filter
28 I '$P(XX,"^",6),PSOST="D" G ORD ;Status Filter
29 I $P(XX,"^",6),PSOST="A" G ORD
30 I '$D(^PS(55,DFN,"NVA",ORD,"OCK")),PSOOC="Y" G ORD ;Order Checks Filter
31 I $D(^PS(55,DFN,"NVA",ORD,"OCK")),PSOOC="N" G ORD
32 ;
33 I PSOSRT=3 D G CLOSE:$D(DIRUT),ORD ;If not Sorting,
34 . I $Y>(IOSL-9) D HDR I $D(DIRUT) Q ;Print the Report
35 . D PRINT(DFN,ORD) Q:$D(DIRUT) S SPF=1 ;Then G ORD
36 ;
37 I PSOSRT[1 S PNAM=$$GET1^DIQ(2,DFN,.01) ;Retrieving Patient
38 I PSOSRT[2 S OINAM=$$GET1^DIQ(50.7,+$P(XX,"^"),.01) ;Name and Orderable
39 S:$G(PNAM)="" PNAM=0 S:$G(OINAM)="" OINAM=0 ;Item Name
40 S (S1,S2,S3,S4,S5)=0
41 F I=1:1:$L(PSOSRT,",") D
42 . S Y=$P(PSOSRT,",",I),STS=+$P(XX,"^",6)
43 . S OCK=$S($D(^PS(55,DFN,"NVA",ORD,"OCK")):1,1:2)
44 . S @("S"_I)=$S(Y=1:PNAM,Y=2:OINAM,Y=3:DATE,Y=4:+STS,Y=5:OCK)
45 S ^TMP("PSONV",$J,S1,S2,S3,S4,S5,DFN,ORD)=""
46 G ORD
47 ;
48NEXT ; - If not Sorting (already printed), SKIP, otherwise, print the report
49 I PSOSRT="" G NDTP
50 S (S1,S2,S3,S4,S5,DFN,ORD)=""
51 F S S1=$O(^TMP("PSONV",$J,S1)) Q:S1="" D Q:$D(DIRUT)
52 . F S S2=$O(^TMP("PSONV",$J,S1,S2)) Q:S2="" D Q:$D(DIRUT)
53 . . F S S3=$O(^TMP("PSONV",$J,S1,S2,S3)) Q:S3="" D Q:$D(DIRUT)
54 . . . F S S4=$O(^TMP("PSONV",$J,S1,S2,S3,S4)) Q:S4="" D Q:$D(DIRUT)
55 . . . . F S S5=$O(^TMP("PSONV",$J,S1,S2,S3,S4,S5)) Q:S5="" D Q:$D(DIRUT)
56 . . . . . F S DFN=$O(^TMP("PSONV",$J,S1,S2,S3,S4,S5,DFN)) Q:DFN="" D Q:$D(DIRUT)
57 . . . . . . F S ORD=$O(^TMP("PSONV",$J,S1,S2,S3,S4,S5,DFN,ORD)) Q:ORD="" D Q:$D(DIRUT)
58 . . . . . . . I $Y>(IOSL-12) D HDR I $D(DIRUT) Q
59 . . . . . . . D PRINT(DFN,ORD)
60 . . I '$D(DIRUT),S2'=0,$O(^TMP("PSONV",$J,S1,S2))'="" W SP2
61 . I '$D(DIRUT),$O(^TMP("PSONV",$J,S1))'="" W SP1
62 G CLOSE:$D(DIRUT)
63 ;
64NDTP I 'PRTD D HDR W !!?18,"********** NO DATA TO PRINT **********"
65 I PRTD D
66 . W SP1
67 . W !,"Total: ",PCNT," patient",$S(PCNT>1:"s",1:"")
68 . W " and ",OCNT," order",$S(OCNT>1:"s",1:""),"."
69 ;
70CLOSE D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
71END K ^TMP("PSONV",$J),^TMP("PSOCNT",$J)
72 Q
73 ;
74PRINT(DFN,ORD) ; - Print a Non-VA Med Order
75 ;Input: DFN-Patient;ORD-Non-VA Order#
76 N X,XX,K,OI,OIX,OINAM,DGNAM,PNAM,PSSN,CLNAM,PRV,I,J,Z,TXT,VAPA,VADM,SCH
77 N STR,OCK
78 ;
79 I '$D(^PS(55,DFN,"NVA",ORD)) Q
80 I '$G(PAG) D HDR I $D(DIRUT) Q
81 ;
82 S XX=^PS(55,DFN,"NVA",ORD,0),OINAM=$$GET1^DIQ(50.7,+$P(XX,"^"),.01)
83 S DGNAM="" I $P(XX,"^",2) S DGNAM=$$GET1^DIQ(50,+$P(XX,"^",2),.01)
84 D DEM^VADPT,ADD^VADPT S PNAM=$P(VADM(1),"^"),PSSN=$P($G(VADM(2)),"^",2)
85 W !,PNAM," (ID:",$S(PSSN:$P(PSSN,"-",3),1:"0000"),")"
86 W ?46,"Patient Phone #: ",$E($P(VAPA(8),"^"),1,16)
87 S:'$D(^TMP("PSOCNT",$J,DFN)) PCNT=PCNT+1 S ^TMP("PSOCNT",$J,DFN)=""
88 ;
89 W !?5,"Non-VA Med: ",OINAM
90 W !?2,"Dispense Drug: ",$E(DGNAM,1,37)
91 W ?55,"Dosage: ",$E($P(XX,"^",3),1,16)
92 W !?7,"Schedule: " S X=$E($P(XX,"^",5),1,30)
93 S SCH=$S($L($P(XX,"^",5))>30:$P(X," ",1,$L(X," ")-1),1:X) W SCH
94 W ?52,"Med Route: ",$E($P(XX,"^",4),1,35)
95 I $E($P(XX,"^",5),$L(SCH)+1,99)'="" D
96 . W !?16,$E($P(XX,"^",5),$L(SCH)+1,99)
97 W !?9,"Status: ",$S('$P(XX,"^",6):"ACTIVE",1:"DISCONTINUED on "_$$DT($P(XX,"^",7)))
98 W ?49,"CPRS Order #: ",$P(XX,"^",8)
99 W !?2,"Documented By: ",$E($$GET1^DIQ(200,+$P(XX,"^",11),.01),1,29)
100 W ?46,"Documented Date: ",$$DT($P(XX,"^",10))
101 S CLNAM=$$GET1^DIQ(44,+$P(XX,"^",12),.01)
102 W !?9,"Clinic: " W:$P(XX,"^",12) $E($P(XX,"^",12)_" - "_CLNAM,1,33)
103 W ?51,"Start Date: ",$$DT($P(XX,"^",9)),!
104 ;
105 ; - Printing "Order Checks" fields
106 W:$D(^PS(55,DFN,"NVA",ORD,"OCK")) !
107 F I=0:0 S I=$O(^PS(55,DFN,"NVA",ORD,"OCK",I)) Q:'I D Q:$D(DIRUT)
108 . S OCK=^PS(55,DFN,"NVA",ORD,"OCK",I,0),STR=$P(OCK,"^"),PRV=+$P(OCK,"^",2)
109 . I $Y>(IOSL-5) D HDR Q:$D(DIRUT) W !
110 . W ?1,"Order Check #",I,": " K TXT D TEXT(.TXT,STR,61)
111 . F K=1:1 Q:'$D(TXT(K)) D Q:$D(DIRUT)
112 . . W ?17,TXT(K),! I $Y>(IOSL-4) D HDR Q:$D(DIRUT) W !
113 . Q:$D(DIRUT) K TXT
114 . F J=0:0 S J=$O(^PS(55,DFN,"NVA",ORD,"OCK",I,"OVR",J)) Q:'J D
115 . . S STR=^PS(55,DFN,"NVA",ORD,"OCK",I,"OVR",J,0)
116 . . D TEXT(.TXT,STR,56)
117 . W ?6,"Override Reason: " W:'$D(TXT) !
118 . F K=1:1 Q:'$D(TXT(K)) D Q:$D(DIRUT)
119 . . W ?23,TXT(K),! I $Y>(IOSL-4) D HDR Q:$D(DIRUT) W !
120 . Q:$D(DIRUT)
121 . W ?6,"Override Provider: " W:PRV $$GET1^DIQ(200,+PRV,.01) W !
122 Q:$D(DIRUT)
123 ;
124 ; - Printing "Statement/Explanation/Comments" field
125 I $D(^PS(55,DFN,"NVA",ORD,"DSC")) D Q:$D(DIRUT)
126 . W !,"Statement/Explanation/Comments: " K TXT
127 . F I=0:0 S I=$O(^PS(55,DFN,"NVA",ORD,"DSC",I)) Q:'I D
128 . . S STR=^PS(55,DFN,"NVA",ORD,"DSC",I,0)
129 . . D TEXT(.TXT,STR,47)
130 . F K=1:1 Q:'$D(TXT(K)) D Q:$D(DIRUT)
131 . . W ?32,TXT(K),! I $Y>(IOSL-4) D HDR Q:$D(DIRUT) W !
132 ;
133 S PRTD=1,OCNT=OCNT+1
134 Q
135 ;
136TEXT(TEXT,STR,L) ; Formats STR into TEXT array, lines lenght = L
137 N J,WORD,K S K=+$O(TEXT(""),-1) S:'K K=1
138 F J=1:1:$L(STR," ") D
139 . S WORD=$P(STR," ",J) I ($L($G(TEXT(K))_WORD))>L S K=K+1
140 . S TEXT(K)=$G(TEXT(K))_WORD_" "
141 Q
142 ;
143HDR ; - Prints the Header
144 N X,DIR S PAG=$G(PAG)+1
145 I PAG>1,$E(IOST)="C" D Q:$D(DIRUT)
146 . S DIR(0)="E",DIR("A")=" Press ENTER to Continue or ^ to Exit" D ^DIR
147 ;
148 W @IOF,"Non-VA Meds Usage Report",?74,"Page: ",$J(PAG,3)
149 W !,"Sorted by",$$SRT(PSOSRT)
150 W !,"Date Range: "_$$DT(PSOSD+1\1)_" - "_$$DT(PSOED\1)
151 W ?48,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT())
152 S X="",$P(X,"-",80)="" W !,X
153 Q
154 ;
155SRT(ST) ; - Convert the "1,2,4" (example) to "PATIENT,ORDERABLE ITEM,STATUS"
156 ;Input: ST-String with the Sorting fields by number
157 ;Output: ST-String with the Sorting fields by name
158 N I,X,STR,FLD
159 S STR="PATIENT NAME^ORDERABLE ITEM^DATE DOCUMENTED^STATUS^ORDER CHECKS"
160 F I=1:1:$L(ST,",") D
161 . S FLD=+$P(ST,",",I),X=$P(STR,"^",FLD)
162 . S $P(ST,",",I)=" "_X
163 Q ST
164 ;
165DT(DT) ; - Convert FM Date to MM/DD/YYYY
166 I 'DT Q ""
167 I '(DT#10000) Q (1700+$E(DT,1,3))
168 I '(DT#100) Q $E(DT,4,5)_"/"_(1700+$E(DT,1,3))
169 Q $E(DT,4,5)_"/"_$E(DT,6,7)_"/"_(1700+$E(DT,1,3))
Note: See TracBrowser for help on using the repository browser.