source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSONVARP.m@ 677

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

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1PSONVARP ;BHM/MFR - Non-VA Med Usage Report - Input ;04/10/03
2 ;;7.0;OUTPATIENT PHARMACY;**132,118**;13 Feb 97
3 ;External reference to ^%DT is supported by DBIA 10003
4 ;External reference to ^%ZTLOAD is supported by DBIA 10063
5 ;External reference to ^%ZIS is supported by DBIA 10086
6 ;External reference to ^DIR is supported by DBIA 10026
7 ;External reference to ^XLFSTR is supported by DBIA 10104
8 ;
9HID ; - Entrhy point from the Hidden Action in the Medication Profile
10 N PSOHDFLG S PSOHDFLG=1
11 ;
12EN N PSOSD,PSOED,PSOST,PSOSRT,PSOAPT,PSOAOI,PSOST,PSOOC,PSOAPT,PSOAOI,I,Y
13 N OK,X,C,%DT
14 ;
15 ; - Ask for FROM DATE DOCUMENTED
16 S %DT(0)=-DT,%DT="AEP",%DT("A")="FROM DATE DOCUMENTED: "
17 W ! D ^%DT I Y<0!($D(DTOUT)) G END
18 S PSOSD=Y\1-.00001
19 ;
20ENDT ; - Ask for TO DATE DOCUMENTED
21 S %DT(0)=PSOSD+1\1,%DT("A")="TO DATE DOCUMENTED: "
22 W ! D ^%DT I Y<0!($D(DTOUT)) G END
23 S PSOED=Y\1+.99999
24 ;
25 ; - Reported called from a Hidden Action menu
26 I $G(PSOHDFLG) D G DEV
27 . S PSOPT(DFN)="",PSOAPT=0,PSOAOI=1,PSOST="B",PSOOC="B",PSOSRT="4,2"
28 ;
29SORT ; - Ask for SORT BY
30 K DIR S DIR("B")="PATIENT NAME" D HL1("A")
31SORT1 S PSOSRT="",(PSOAPT,PSOAOI)=1,(PSOST,PSOOC)="B"
32 S DIR("A")="SORT BY",DIR(0)="FO" D HL1("?")
33 W ! D ^DIR K DIR I $D(DIRUT) G END
34 ;
35 S OK=1,C=15 W !
36 F I=1:1:$L(Y,",") D
37 . S X=$P(Y,",",I) S:X'?.N X=$$TRNS(X) I PSOSRT[X Q
38 . W !?(C-10),$S(I=1:"SORT BY ",1:"THEN BY ") S C=C+5
39 . I X<1!(X>5) W X,"???",$C(7) S OK=0 Q
40 . W $P("PATIENT NAME^ORDERABLE ITEM^DATE DOCUMENTED^STATUS^ORDER CHECKS","^",X)
41 . S PSOSRT=PSOSRT_","_X
42 I 'OK S DIR("B")=Y G SORT1
43 S $E(PSOSRT)=""
44 ;
45 S OK=1
46 F I=1:1:$L(PSOSRT,",") D I 'OK Q
47 . S X=$P(PSOSRT,",",I) D:X'=3 @("SRT"_X)
48 I 'OK S DIR("B")="PATIENT NAME" G SORT1
49 ;
50DEV W ! K %ZIS,IOP,POP,ZTSK S %ZIS="QM" D ^%ZIS K %ZIS I POP G END
51 I $D(IO("Q")) D G END
52 . N G K IO("Q"),ZTIO,ZTSAVE,ZTDTH,ZTSK
53 . S ZTRTN="EN^PSONVAR1",ZTDESC="Non-VA Meds Usage Report"
54 . F G="PSOSD","PSOED","PSOSRT","PSOPT","PSOOI" S:$D(@G) ZTSAVE(G)=""
55 . F G="PSOST","PSOOC","PSOAPT","PSOAOI" S:$D(@G) ZTSAVE(G)=""
56 . S:$D(PSOPT) ZTSAVE("PSOPT(")="" S:$D(PSOOI) ZTSAVE("PSOOI(")=""
57 . D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print !!" K ZTSK
58 ;
59 G EN^PSONVAR1
60 ;
61END Q
62 ;
63SRT1 ; - Selection of PATIENTS to print on the Report
64 N DIC,X,I K PSOPT S PSOAPT=0
65 W !!,?5,"You may select a single or multiple PATIENTS,"
66 W !,?5,"or enter ^ALL to select all PATIENTS.",!
67 S DIC=2,DIC(0)="QEAM",DIC("A")=" PATIENT: "
68 F D ^DIC Q:Y<0 S:'$$DEAD(+Y,1) PSOPT(+Y)="" K DIC("B")
69 I X="^ALL" S PSOAPT=1 K PSOPT,DUOUT Q
70 I $D(DUOUT)!($D(DTOUT)) S OK=0 Q
71 I '$D(PSOPT),Y<0 S OK=0 Q
72 Q
73 ;
74SRT2 ; - Selection of ORDERABLE ITEMS to print on the Report
75 N DIC,X,I K PSOOI S PSOAOI=0
76 W !!,?5,"You may select a single or multiple ORDERABLE ITEMS,"
77 W !,?5,"or enter ^ALL to select all ORDERABLE ITEMS.",!
78 S DIC=50.7,DIC(0)="QEAM",DIC("A")=" ORDERABLE ITEM: "
79 F D ^DIC Q:Y<0 S PSOOI(+Y)="" K DIC("B")
80 I X="^ALL" S PSOAOI=1 K PSOOI,DUOUT Q
81 I $D(DUOUT)!($D(DTOUT)) S OK=0 Q
82 I '$D(PSOOI)&(Y<0) S OK=0 Q
83 Q
84 ;
85SRT4 ; - Selection of STATUS to print on the Report
86 N DIR,X,I K PSOST
87 W !!,?5,"You may select (A)CTIVE, (D)ISCONTINUED or (B)OTH status.",!
88 S DIR(0)="SAO^A:ACTIVE;D:DISCONTINUED;B:BOTH"
89 S DIR("A")=" STATUS: ",DIR("B")="ACTIVE" D ^DIR
90 I $D(DIRUT) S OK=0 Q
91 S PSOST=Y
92 Q
93 ;
94SRT5 ; - Selection of ORDER CHECKS to print on the Report
95 N DIR,X,OP1,OP2 K PSOOC
96 S OP1="ORDERS WITH ORDER CHECKS ONLY"
97 S OP2="ORDERS WITHOUT ORDER CHECKS ONLY"
98 W !!,?5,"You may select 'Y' to print ",OP1,","
99 W !?5,"'N' to print ",OP2," or 'B' for BOTH.",!
100 S DIR(0)="SAO^Y:"_OP1_";N:"_OP2_";B:BOTH"
101 S DIR("A")=" ORDER CHECKS: ",DIR("B")="BOTH" D ^DIR
102 I $D(DIRUT) S OK=0 Q
103 S PSOOC=Y
104 Q
105 ;
106TRNS(X) ; - Translates Alpha into the corresponding Sorting Code
107 N L,UPX S L=$L(X),UPX=$$UP^XLFSTR(X)
108 I $E("PATIENT NAME",1,L)=UPX Q 1
109 I $E("ORDERABLE ITEM",1,L)=UPX Q 2
110 I $E("DATE DOCUMENTED",1,L)=UPX Q 3
111 I $E("STATUS",1,L)=UPX Q 4
112 I $E("ORDER CHECKS",1,L)=UPX Q 5
113 Q X
114 ;
115DEAD(DFN,DSPL) ; Check if Patient has a Date Of Death on File
116 N VADM,Y
117 I '$G(DFN) Q 0
118 D DEM^VADPT I $G(VADM(6))="" Q 0
119 I $G(DSPL) W !?10,$P($G(VADM(1)),"^")," (",$P($G(VADM(2)),"^",2),") DIED ",$P($G(VADM(6)),"^",2),$C(7)
120 Q 1
121 ;
122HL1(S) ; - Help for the SORT BY prompt
123 S DIR(S,1)=" Enter the SORT field(s) for this Report:"
124 S DIR(S,2)=" "
125 S DIR(S,3)=" 1 - PATIENT NAME"
126 S DIR(S,4)=" 2 - ORDERABLE ITEM"
127 S DIR(S,5)=" 3 - DATE DOCUMENTED"
128 S DIR(S,6)=" 4 - STATUS"
129 S DIR(S,7)=" 5 - ORDER CHECKS"
130 S DIR(S,8)=" "
131 S DIR(S,9)=" Or any combination of the above, separated by comma,"
132 S DIR(S,10)=" as in these examples:"
133 S DIR(S,11)=" "
134 S DIR(S,12)=" 2,1 - BY ORDERABLE ITEM, THEN BY PATIENT NAME"
135 S DIR(S,13)=" 5,1,4 - BY ORDER CHECKS, THEN BY PATIENT NAME, THEN BY STATUS"
136 S DIR(S,14)=" "
137 S DIR(S)=" "
138 Q
Note: See TracBrowser for help on using the repository browser.