PSOQUAP2 ;HINES/RMS - UNIFIED PROFILE BASED ON PORTLAND IDEA ; 30 Nov 2007 7:58 AM ;;7.0;OUTPATIENT PHARMACY;**294**;DEC 1997;Build 13 ; ;Reference to COVER^ORWPS supported by DBIA 4954 ;Reference to BCMALG^PSJUTL2 supported by DBIA 5057 EN ;ENTRY POINT FOR HEALTH SUMMARY N RPC,RPCT,ALPHA,PSNUM,DRUGNM,RPCNODE,ORDER,SAVE D COVER^ORWPS(.RPC,DFN) S RPCT=0 F S RPCT=$O(RPC(RPCT)) Q:'+RPCT D ; . S RPCNODE=RPC(RPCT) . S PSNUM=$P(RPCNODE,"^") . S DRUGNM=$$UP^XLFSTR($P(RPCNODE,"^",2)) . S ORDER=+$P(RPCNODE,"^",3) . Q:DRUGNM']""!(ORDER=0)!(PSNUM']"") . K SAVE(DRUGNM) S SAVE(DRUGNM,ORDER,PSNUM)="" . Q:"ACTIVE^ACTIVE/SUSP^HOLD"'[$P(RPCNODE,"^",4) . S ALPHA(DRUGNM,ORDER,PSNUM)="" D ADDREM D HEADER D OUTPUT D FOOTER Q HEADER N ATEST,ADATE,AVALUE,ATEXT D NVADT^PSOQCF04(DFN,.ATEST,.ADATE,.AVALUE,.ATEXT) D CKP^GMTSUP Q:$D(GMTSQIT) W $$REPEAT^XLFSTR("-",IOM),!,"Alphabetized list of outpatient Rx's, inpatient orders, remote and Non-VA meds" D CKP^GMTSUP Q:$D(GMTSQIT) W !,"Legend: OPT = VA issued outpatient prescription, INP = VA issued inpatient order" D CKP^GMTSUP Q:$D(GMTSQIT) W !,"Non-VA Meds Last Documented On: " W $S(+ADATE:$$FMTE^XLFDT(ADATE,"D"),1:"** Data not found **") D CKP^GMTSUP Q:$D(GMTSQIT) W !,$$REPEAT^XLFSTR("-",IOM) D CKP^GMTSUP Q:$D(GMTSQIT) Q OUTPUT N DRUGNM,ORDER,PSNUM N PACK,PACKREF,SIGLINE,ORDNUM N LASTACT,OTLINE S DRUGNM="" F S DRUGNM=$O(ALPHA(DRUGNM)) Q:DRUGNM']"" D K SAVE(DRUGNM) ; . S ORDER="" F S ORDER=$O(ALPHA(DRUGNM,ORDER)) Q:ORDER']"" D ; .. S PSNUM="" F S PSNUM=$O(ALPHA(DRUGNM,ORDER,PSNUM)) Q:PSNUM']"" D ; ... S PACK=$P(PSNUM,";",2),ORDNUM=$P(PSNUM,";") ... I PACK="I" D INPDISP ... I PACK="O" D OPTDISP ... I PACK="R" D RDIDISP Q FOOTER D CKP^GMTSUP Q:$D(GMTSQIT) N BLINE S BLINE=$$REPEAT^XLFSTR("-",IOM) W !,BLINE,!,"Other medications previously dispensed in the last year:",! D CKP^GMTSUP Q:$D(GMTSQIT) N DRUGNM,ORDER,PSNUM N PACK,PACKREF,SIGLINE S DRUGNM="" F S DRUGNM=$O(SAVE(DRUGNM)) Q:DRUGNM']"" D ; . S ORDER="" F S ORDER=$O(SAVE(DRUGNM,ORDER)) Q:ORDER']"" D ; .. S PSNUM="" F S PSNUM=$O(SAVE(DRUGNM,ORDER,PSNUM)) Q:PSNUM']"" D ; ... S PACK=$P(PSNUM,";",2) ... I PACK="O" D OPTFOOT Q ADDREM ;6-21-07 ADD ACTIVE MEDS VIA REMOTE DATA INTEROPERABILITY N PSOQRDI,PSOQMED,PSOQSTAT,PSOQRNAM,PSOQRNUM,PSOQDOWN Q:'$$HAVEHDR^ORRDI1 D Q:$G(PSOQDOWN) . I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) H $$GET^XPAR("ALL","ORRDI PING FREQ")/2 . I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) S PSOQDOWN=1 D .. D CKP^GMTSUP Q:$D(GMTSQIT) .. W !,"WARNING: Connection to Remote Data Currently Down",! .. D CKP^GMTSUP Q:$D(GMTSQIT) D ;18-MAR-08 TO ALLOW HDR/RDI PROCESS TO USE IO VARIABLE . D SAVDEV^%ZISUTL("PSOQHFS") . S PSOQRDI=$$GET^ORRDI1(DFN,"PSOO") . D USE^%ZISUTL("PSOQHFS") . D RMDEV^%ZISUTL("PSOQHFS") I PSOQRDI=-1 D . D CKP^GMTSUP Q:$D(GMTSQIT) . W !,"WARNING: Connection to Remote Data Not Available",! . D CKP^GMTSUP Q:$D(GMTSQIT) Q:'$D(^XTMP("ORRDI","PSOO",DFN)) S PSOQMED=0 F S PSOQMED=$O(^XTMP("ORRDI","PSOO",DFN,PSOQMED)) Q:'+PSOQMED D . S PSOQSTAT=$G(^XTMP("ORRDI","PSOO",DFN,PSOQMED,5,0)) . Q:PSOQSTAT']"" ;8-3-07 TO CATCH INCOMPLETE RECORDS . Q:"ACTIVE^SUSPENDED"'[PSOQSTAT . S PSOQRNAM=$G(^XTMP("ORRDI","PSOO",DFN,PSOQMED,2,0),"Unknown Drug") . S PSOQRNUM=$G(^XTMP("ORRDI","PSOO",DFN,PSOQMED,4,0)) . Q:PSOQRNAM']""!(PSOQRNUM']"") . S ALPHA(PSOQRNAM,PSOQRNUM,PSOQMED_"X;R")="" Q OPTFOOT N PSOQLRD,PSOQYEAR S PACKREF=+$G(^OR(100,ORDER,4)) S X1=DT,X2=-365 D C^%DTC S PSOQYEAR=X S PSOQLRD=$$LRDFUNC^PSOQ0076(PACKREF) D CKP^GMTSUP Q:$D(GMTSQIT) Q:PSOQLRD54 ! ;NEW LINE IF THE STATUS+STATION IS TOO LONG W ?55,"Days Supply: "_$P($P($G(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,6,0)),";",2),"D",2) D CKP^GMTSUP Q:$D(GMTSQIT) W !?10,"Rx Expiration Date: ",$G(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,7,0)),?55,"Refills Remaining: ",$G(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,10,0)) D CKP^GMTSUP Q:$D(GMTSQIT) W ! D CKP^GMTSUP Q:$D(GMTSQIT) Q NVADISP D CKP^GMTSUP Q:$D(GMTSQIT) W !,"Non VA "_DRUGNM D CKP^GMTSUP Q:$D(GMTSQIT) S LASTACT=$O(^OR(100,ORDER,8,":"),-1) S OTLINE=1 F S OTLINE=$O(^OR(100,ORDER,8,LASTACT,.1,OTLINE)) Q:'+OTLINE D ; .D WRAPTEXT^PSOQUTIL($G(^OR(100,ORDER,8,LASTACT,.1,OTLINE,0)),65,5) D CKP^GMTSUP Q:$D(GMTSQIT) W ! D CKP^GMTSUP Q:$D(GMTSQIT) Q