source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOQUAP.m@ 1742

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1PSOQUAP ;HINES/RMS - UNIFIED PROFILE BASED ON PORTLAND IDEA ; 30 Nov 2007 7:57 AM
2 ;;7.0;OUTPATIENT PHARMACY;**294**;DEC 1997;Build 13
3 ;
4 ;Reference to BCMALG^PSJUTL2 supported by DBIA 5057
5 ;Reference to CKP^GMTSUP supported by DBIA 4231
6 ;Reference to COVER^ORWPS supported by DBIA 4954
7EN ;ENTRY POINT FOR HEALTH SUMMARY
8 N RPC,RPCT,ALPHA,PSNUM,DRUGNM,RPCNODE,ORDER,SAVE
9 D COVER^ORWPS(.RPC,DFN)
10 S RPCT=0 F S RPCT=$O(RPC(RPCT)) Q:'+RPCT D ;
11 . S RPCNODE=RPC(RPCT)
12 . S PSNUM=$P(RPCNODE,"^")
13 . S DRUGNM=$$UP^XLFSTR($P(RPCNODE,"^",2))
14 . S ORDER=+$P(RPCNODE,"^",3)
15 . K SAVE(DRUGNM) S SAVE(DRUGNM,ORDER,PSNUM)=""
16 . Q:"ACTIVE^ACTIVE/SUSP"'[$P(RPCNODE,"^",4)
17 . S ALPHA(DRUGNM,ORDER,PSNUM)=""
18 D HEADER
19 D OUTPUT
20 D FOOTER
21 Q
22HEADER N ATEST,ADATE,AVALUE,ATEXT
23 D NVADT^PSOQCF04(DFN,.ATEST,.ADATE,.AVALUE,.ATEXT)
24 D CKP^GMTSUP Q:$D(GMTSQIT)
25 W $$REPEAT^XLFSTR("-",IOM),!,"Alphabetical list of all prescriptions, inpatient orders and Non-VA meds"
26 D CKP^GMTSUP Q:$D(GMTSQIT)
27 W !,"Legend: OPT = VA issued outpatient prescription, INP = VA issued inpatient order"
28 D CKP^GMTSUP Q:$D(GMTSQIT)
29 W !,"Non-VA Meds Last Documented On: "
30 W $S(+ADATE:$$FMTE^XLFDT(ADATE,"D"),1:"** Data not found **")
31 D CKP^GMTSUP Q:$D(GMTSQIT)
32 W !,$$REPEAT^XLFSTR("-",IOM)
33 D CKP^GMTSUP Q:$D(GMTSQIT)
34 Q
35OUTPUT N DRUGNM,ORDER,PSNUM
36 N PACK,PACKREF,SIGLINE,ORDNUM
37 N LASTACT,OTLINE
38 S DRUGNM="" F S DRUGNM=$O(ALPHA(DRUGNM)) Q:DRUGNM']"" D K SAVE(DRUGNM) ;
39 . S ORDER="" F S ORDER=$O(ALPHA(DRUGNM,ORDER)) Q:ORDER']"" D ;
40 .. S PSNUM="" F S PSNUM=$O(ALPHA(DRUGNM,ORDER,PSNUM)) Q:PSNUM']"" D ;
41 ... S PACK=$P(PSNUM,";",2),ORDNUM=$P(PSNUM,";")
42 ... I PACK="I" D INPDISP
43 ... I PACK="O" D OPTDISP
44 Q
45FOOTER D CKP^GMTSUP Q:$D(GMTSQIT)
46 N BLINE
47 S BLINE=$$REPEAT^XLFSTR("-",IOM)
48 W !,BLINE,!,"Other medications previously dispensed in the last year:",!
49 D CKP^GMTSUP Q:$D(GMTSQIT)
50 N DRUGNM,ORDER,PSNUM
51 N PACK,PACKREF,SIGLINE
52 S DRUGNM="" F S DRUGNM=$O(SAVE(DRUGNM)) Q:DRUGNM']"" D ;
53 . S ORDER="" F S ORDER=$O(SAVE(DRUGNM,ORDER)) Q:ORDER']"" D ;
54 .. S PSNUM="" F S PSNUM=$O(SAVE(DRUGNM,ORDER,PSNUM)) Q:PSNUM']"" D ;
55 ... S PACK=$P(PSNUM,";",2)
56 ... I PACK="O" D OPTFOOT
57 Q
58OPTFOOT N PSOQLRD,PSOQYEAR
59 S PACKREF=+$G(^OR(100,ORDER,4))
60 S X1=DT,X2=-365 D C^%DTC S PSOQYEAR=X
61 S PSOQLRD=$$LRDFUNC^PSOQ0076(PACKREF)
62 D CKP^GMTSUP Q:$D(GMTSQIT)
63 Q:PSOQLRD<PSOQYEAR
64 Q:$P(PSNUM,";")["N"
65 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)
66 S SIGLINE=0 F S SIGLINE=$O(^PSRX(PACKREF,"SIG1",SIGLINE)) Q:'+SIGLINE D ;
67 . W !?5,$G(^PSRX(PACKREF,"SIG1",SIGLINE,0)) D CKP^GMTSUP Q:$D(GMTSQIT)
68 W ! D CKP^GMTSUP Q:$D(GMTSQIT)
69 Q
70INPDISP D CKP^GMTSUP Q:$D(GMTSQIT)
71 W !,"INP "_DRUGNM D CKP^GMTSUP Q:$D(GMTSQIT)
72 S LASTACT=$O(^OR(100,+ORDER,8,":"),-1)
73 S OTLINE=1 F S OTLINE=$O(^OR(100,+ORDER,8,LASTACT,.1,OTLINE)) Q:'+OTLINE D ;
74 . W !?5,$$LSIG^PSOQUTIL($G(^OR(100,+ORDER,8,LASTACT,.1,OTLINE,0))) D CKP^GMTSUP Q:$D(GMTSQIT)
75 . W !?5,$$BCMALG^PSJUTL2(DFN,ORDNUM) D CKP^GMTSUP Q:$D(GMTSQIT)
76 W ! D CKP^GMTSUP Q:$D(GMTSQIT)
77 Q
78OPTDISP N PSOQEXP,PSOQREF
79 D CKP^GMTSUP Q:$D(GMTSQIT)
80 S PACKREF=+$G(^OR(100,ORDER,4))
81 S PSOQLRD=$$LRDFUNC^PSOQ0076(PACKREF)
82 S PSOQEXP=$$EXPDATE^PSOQ0076(PACKREF)
83 S PSOQREF=$$REFILLS^PSOQ0076(PACKREF)
84 I $P(PSNUM,";")["N" G NVADISP
85 W !,"OPT "_DRUGNM
86 S SIGLINE=0 F S SIGLINE=$O(^PSRX(PACKREF,"SIG1",SIGLINE)) Q:'+SIGLINE D ;
87 . W !?5,$G(^PSRX(PACKREF,"SIG1",SIGLINE,0)) D CKP^GMTSUP Q:$D(GMTSQIT)
88 W !?15,"Last Released: "_$$FMTE^XLFDT(PSOQLRD,"2D"),?55,"Days Supply: "_$$DAYSSUPP^PSOQ0076(PACKREF) D CKP^GMTSUP Q:$D(GMTSQIT)
89 W !?15,"Rx Expiration Date: ",$$FMTE^XLFDT(PSOQEXP,"2D"),?55,"Refills Remaining: ",PSOQREF D CKP^GMTSUP Q:$D(GMTSQIT)
90 W ! D CKP^GMTSUP Q:$D(GMTSQIT)
91 Q
92NVADISP D CKP^GMTSUP Q:$D(GMTSQIT)
93 W !,"Non VA "_DRUGNM D CKP^GMTSUP Q:$D(GMTSQIT)
94 S LASTACT=$O(^OR(100,ORDER,8,":"),-1)
95 S OTLINE=1 F S OTLINE=$O(^OR(100,ORDER,8,LASTACT,.1,OTLINE)) Q:'+OTLINE D ;
96 . W !?5,$G(^OR(100,ORDER,8,LASTACT,.1,OTLINE,0)) D CKP^GMTSUP Q:$D(GMTSQIT)
97 W ! D CKP^GMTSUP Q:$D(GMTSQIT)
98 Q
Note: See TracBrowser for help on using the repository browser.