Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOQUAP2

PSOQUAP2.m

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