source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOQUAP2.m@ 1114

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

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1PSOQUAP2 ;HINES/RMS - UNIFIED PROFILE BASED ON PORTLAND IDEA ; 30 Nov 2007 7:58 AM
2 ;;7.0;OUTPATIENT PHARMACY;**294**;DEC 1997;Build 13
3 ;
4 ;Reference to COVER^ORWPS supported by DBIA 4954
5 ;Reference to BCMALG^PSJUTL2 supported by DBIA 5057
6EN ;ENTRY POINT FOR HEALTH SUMMARY
7 N RPC,RPCT,ALPHA,PSNUM,DRUGNM,RPCNODE,ORDER,SAVE
8 D COVER^ORWPS(.RPC,DFN)
9 S RPCT=0 F S RPCT=$O(RPC(RPCT)) Q:'+RPCT D ;
10 . S RPCNODE=RPC(RPCT)
11 . S PSNUM=$P(RPCNODE,"^")
12 . S DRUGNM=$$UP^XLFSTR($P(RPCNODE,"^",2))
13 . S ORDER=+$P(RPCNODE,"^",3)
14 . Q:DRUGNM']""!(ORDER=0)!(PSNUM']"")
15 . K SAVE(DRUGNM) S SAVE(DRUGNM,ORDER,PSNUM)=""
16 . Q:"ACTIVE^ACTIVE/SUSP^HOLD"'[$P(RPCNODE,"^",4)
17 . S ALPHA(DRUGNM,ORDER,PSNUM)=""
18 D ADDREM
19 D HEADER
20 D OUTPUT
21 D FOOTER
22 Q
23HEADER N ATEST,ADATE,AVALUE,ATEXT
24 D NVADT^PSOQCF04(DFN,.ATEST,.ADATE,.AVALUE,.ATEXT)
25 D CKP^GMTSUP Q:$D(GMTSQIT)
26 W $$REPEAT^XLFSTR("-",IOM),!,"Alphabetized list of outpatient Rx's, inpatient orders, remote and Non-VA meds"
27 D CKP^GMTSUP Q:$D(GMTSQIT)
28 W !,"Legend: OPT = VA issued outpatient prescription, INP = VA issued inpatient order"
29 D CKP^GMTSUP Q:$D(GMTSQIT)
30 W !,"Non-VA Meds Last Documented On: "
31 W $S(+ADATE:$$FMTE^XLFDT(ADATE,"D"),1:"** Data not found **")
32 D CKP^GMTSUP Q:$D(GMTSQIT)
33 W !,$$REPEAT^XLFSTR("-",IOM)
34 D CKP^GMTSUP Q:$D(GMTSQIT)
35 Q
36OUTPUT N DRUGNM,ORDER,PSNUM
37 N PACK,PACKREF,SIGLINE,ORDNUM
38 N LASTACT,OTLINE
39 S DRUGNM="" F S DRUGNM=$O(ALPHA(DRUGNM)) Q:DRUGNM']"" D K SAVE(DRUGNM) ;
40 . S ORDER="" F S ORDER=$O(ALPHA(DRUGNM,ORDER)) Q:ORDER']"" D ;
41 .. S PSNUM="" F S PSNUM=$O(ALPHA(DRUGNM,ORDER,PSNUM)) Q:PSNUM']"" D ;
42 ... S PACK=$P(PSNUM,";",2),ORDNUM=$P(PSNUM,";")
43 ... I PACK="I" D INPDISP
44 ... I PACK="O" D OPTDISP
45 ... I PACK="R" D RDIDISP
46 Q
47FOOTER D CKP^GMTSUP Q:$D(GMTSQIT)
48 N BLINE
49 S BLINE=$$REPEAT^XLFSTR("-",IOM)
50 W !,BLINE,!,"Other medications previously dispensed in the last year:",!
51 D CKP^GMTSUP Q:$D(GMTSQIT)
52 N DRUGNM,ORDER,PSNUM
53 N PACK,PACKREF,SIGLINE
54 S DRUGNM="" F S DRUGNM=$O(SAVE(DRUGNM)) Q:DRUGNM']"" D ;
55 . S ORDER="" F S ORDER=$O(SAVE(DRUGNM,ORDER)) Q:ORDER']"" D ;
56 .. S PSNUM="" F S PSNUM=$O(SAVE(DRUGNM,ORDER,PSNUM)) Q:PSNUM']"" D ;
57 ... S PACK=$P(PSNUM,";",2)
58 ... I PACK="O" D OPTFOOT
59 Q
60ADDREM ;6-21-07 ADD ACTIVE MEDS VIA REMOTE DATA INTEROPERABILITY
61 N PSOQRDI,PSOQMED,PSOQSTAT,PSOQRNAM,PSOQRNUM,PSOQDOWN
62 Q:'$$HAVEHDR^ORRDI1
63 D Q:$G(PSOQDOWN)
64 . I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) H $$GET^XPAR("ALL","ORRDI PING FREQ")/2
65 . I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) S PSOQDOWN=1 D
66 .. D CKP^GMTSUP Q:$D(GMTSQIT)
67 .. W !,"WARNING: Connection to Remote Data Currently Down",!
68 .. D CKP^GMTSUP Q:$D(GMTSQIT)
69 D ;18-MAR-08 TO ALLOW HDR/RDI PROCESS TO USE IO VARIABLE
70 . D SAVDEV^%ZISUTL("PSOQHFS")
71 . S PSOQRDI=$$GET^ORRDI1(DFN,"PSOO")
72 . D USE^%ZISUTL("PSOQHFS")
73 . D RMDEV^%ZISUTL("PSOQHFS")
74 I PSOQRDI=-1 D
75 . D CKP^GMTSUP Q:$D(GMTSQIT)
76 . W !,"WARNING: Connection to Remote Data Not Available",!
77 . D CKP^GMTSUP Q:$D(GMTSQIT)
78 Q:'$D(^XTMP("ORRDI","PSOO",DFN))
79 S PSOQMED=0 F S PSOQMED=$O(^XTMP("ORRDI","PSOO",DFN,PSOQMED)) Q:'+PSOQMED D
80 . S PSOQSTAT=$G(^XTMP("ORRDI","PSOO",DFN,PSOQMED,5,0))
81 . Q:PSOQSTAT']"" ;8-3-07 TO CATCH INCOMPLETE RECORDS
82 . Q:"ACTIVE^SUSPENDED"'[PSOQSTAT
83 . S PSOQRNAM=$G(^XTMP("ORRDI","PSOO",DFN,PSOQMED,2,0),"Unknown Drug")
84 . S PSOQRNUM=$G(^XTMP("ORRDI","PSOO",DFN,PSOQMED,4,0))
85 . Q:PSOQRNAM']""!(PSOQRNUM']"")
86 . S ALPHA(PSOQRNAM,PSOQRNUM,PSOQMED_"X;R")=""
87 Q
88OPTFOOT N PSOQLRD,PSOQYEAR
89 S PACKREF=+$G(^OR(100,ORDER,4))
90 S X1=DT,X2=-365 D C^%DTC S PSOQYEAR=X
91 S PSOQLRD=$$LRDFUNC^PSOQ0076(PACKREF)
92 D CKP^GMTSUP Q:$D(GMTSQIT)
93 Q:PSOQLRD<PSOQYEAR
94 Q:$P(PSNUM,";")["N"
95 W !,"OPT "_DRUGNM_" ("_$$GET1^DIQ(52,+PACKREF,100,"E")_"/"_$$DAYSSUPP^PSOQ0076(PACKREF)_" Days Supply Last Released: "_$$FMTE^XLFDT(PSOQLRD,"2D")_")" D CKP^GMTSUP Q:$D(GMTSQIT)
96 S SIGLINE=0 F S SIGLINE=$O(^PSRX(PACKREF,"SIG1",SIGLINE)) Q:'+SIGLINE D ;
97 . W !?5,$G(^PSRX(PACKREF,"SIG1",SIGLINE,0)) D CKP^GMTSUP Q:$D(GMTSQIT)
98 W ! D CKP^GMTSUP Q:$D(GMTSQIT)
99 Q
100INPDISP D CKP^GMTSUP Q:$D(GMTSQIT)
101 W !,"INP "_DRUGNM D CKP^GMTSUP Q:$D(GMTSQIT)
102 S LASTACT=$O(^OR(100,+ORDER,8,":"),-1)
103 S OTLINE=1 F S OTLINE=$O(^OR(100,+ORDER,8,LASTACT,.1,OTLINE)) Q:'+OTLINE D ;
104 . D WRAPTEXT^PSOQUTIL($$LSIG^PSOQUTIL($G(^OR(100,+ORDER,8,LASTACT,.1,OTLINE,0))),60,5) D CKP^GMTSUP Q:$D(GMTSQIT)
105 . W !?5,$$BCMALG^PSJUTL2(DFN,ORDNUM) D CKP^GMTSUP Q:$D(GMTSQIT)
106 W ! D CKP^GMTSUP Q:$D(GMTSQIT)
107 Q
108OPTDISP N PSOQEXP,PSOQREF,PSOQSTA
109 D CKP^GMTSUP Q:$D(GMTSQIT)
110 S PACKREF=+$G(^OR(100,ORDER,4))
111 S PSOQLRD=$$LRDFUNC^PSOQ0076(PACKREF)
112 S PSOQEXP=$$EXPDATE^PSOQ0076(PACKREF)
113 S PSOQREF=$$REFILLS^PSOQ0076(PACKREF)
114 I $P(PSNUM,";")["N" G NVADISP
115 D ;
116 . N C,Y
117 . S Y=$G(^PSRX(PACKREF,"STA"))
118 . S C=$P(^DD(52,100,0),U,2)
119 . D Y^DIQ
120 . S PSOQSTA=Y
121 W !,"OPT "_DRUGNM_" (Status = "_PSOQSTA_")"
122 S SIGLINE=0 F S SIGLINE=$O(^PSRX(PACKREF,"SIG1",SIGLINE)) Q:'+SIGLINE D ;
123 . W !?5,$G(^PSRX(PACKREF,"SIG1",SIGLINE,0)) D CKP^GMTSUP Q:$D(GMTSQIT)
124 W !?10,"Last Released: "_$$FMTE^XLFDT(PSOQLRD,"2D"),?55,"Days Supply: "_$$DAYSSUPP^PSOQ0076(PACKREF) D CKP^GMTSUP Q:$D(GMTSQIT)
125 W !?10,"Rx Expiration Date: ",$$FMTE^XLFDT(PSOQEXP,"2D"),?55,"Refills Remaining: ",PSOQREF D CKP^GMTSUP Q:$D(GMTSQIT)
126 W ! D CKP^GMTSUP Q:$D(GMTSQIT)
127 Q
128RDIDISP D CKP^GMTSUP Q:$D(GMTSQIT)
129 W !,"Remote "_DRUGNM D CKP^GMTSUP Q:$D(GMTSQIT)
130 N PSOQSIG,PSOQSTAT
131 S PSOQSIG=$G(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,14,0))
132 D WRAPTEXT^PSOQUTIL(PSOQSIG,65,5)
133 D CKP^GMTSUP Q:$D(GMTSQIT)
134 S PSOQSTAT=$G(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,5,0))
135 S PSOQSTAT=$S(PSOQSTAT["ACTIVE":"Active",PSOQSTAT["SUSPENDED":"Active/Suspended",1:"Unknown")
136 W !?10,"Last Filled: "_$G(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,9,0))_" ("_PSOQSTAT_" at "_$G(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,1,0))_") "
137 W:$X>54 ! ;NEW LINE IF THE STATUS+STATION IS TOO LONG
138 W ?55,"Days Supply: "_$P($P($G(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,6,0)),";",2),"D",2)
139 D CKP^GMTSUP Q:$D(GMTSQIT)
140 W !?10,"Rx Expiration Date: ",$G(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,7,0)),?55,"Refills Remaining: ",$G(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,10,0))
141 D CKP^GMTSUP Q:$D(GMTSQIT)
142 W ! D CKP^GMTSUP Q:$D(GMTSQIT)
143 Q
144NVADISP D CKP^GMTSUP Q:$D(GMTSQIT)
145 W !,"Non VA "_DRUGNM D CKP^GMTSUP Q:$D(GMTSQIT)
146 S LASTACT=$O(^OR(100,ORDER,8,":"),-1)
147 S OTLINE=1 F S OTLINE=$O(^OR(100,ORDER,8,LASTACT,.1,OTLINE)) Q:'+OTLINE D ;
148 .D WRAPTEXT^PSOQUTIL($G(^OR(100,ORDER,8,LASTACT,.1,OTLINE,0)),65,5) D CKP^GMTSUP Q:$D(GMTSQIT)
149 W ! D CKP^GMTSUP Q:$D(GMTSQIT)
150 Q
Note: See TracBrowser for help on using the repository browser.