GMTSPSTN ;BIR/RMS - MED RECON TOOL #1 NO GLOSSARY (MED REC PROFILE) ; Jan 31, 2023@12:50:10
;;2.7;Health Summary;**94,127,131,132,135,115,145**;Oct 20, 1995;Build 191
;
; Reference to COVER^ORWPS in ICR #7392
; Reference to $$GET^ORRDI1,$$HAVEHDR^ORRDI1 in ICR #4659
; Reference to ^XTMP("ORRDI","PSOO" in ICR #4660
; Reference to ^XTMP("ORRDI","OUTAGE INFO" in ICR #5440
; Reference to ^PSOHCSUM in ICR #330
; Reference to $$ISCLIN^ORUTL1 in ICR #5691
; Reference to ^OR(100 in ICR #5771
; Reference to ^PS(51 in ICR #1980
; Reference to ^PS(53.1 in ICR #534
; Reference to TEXT^ORQ12 in ICR #4202
; Reference to $$PKGID^ORX8 in ICR #3071
; Reference to BCMALG^PSJUTL2 in ICR #5057
; Reference to OEL^PSOORRL in ICR #2400
; Reference to IMOOD^ORIMO in ICR #7389
TOOL1 ;ENTRY POINT FOR HEALTH SUMMARY
N ALPHA,DRUGNM,EXPDAYS,IND1,LIST,ORDER,PSNUM,RPC,RPCT,RPCNODE,SAVE,SAVERD
D ADD^GMTSPSTR("GMTSPSTN")
S IND1=7,EXPDAYS=90
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,U)
. S DRUGNM=$$UP^XLFSTR($P(RPCNODE,U,2))
. S ORDER=+$P(RPCNODE,U,3)
. Q:DRUGNM']""!(ORDER=0)!(PSNUM']"")
. S SAVERD=9999999-$$LRD(+$G(^OR(100,ORDER,4)))
. S SAVE(DRUGNM,SAVERD,ORDER,PSNUM)=""
. Q:("ACTIVE^ACTIVE/SUSP^ACTIVE/PARKED^HOLD^PENDING^ON CALL"'[$P(RPCNODE,U,4))&($P(PSNUM,";")["N")
. S ALPHA(1,DRUGNM,ORDER,PSNUM)=$P(RPCNODE,U,4)
D ADDREM
D HEADER
S LIST=1 D OUTPUT
D CKP Q:$D(GMTSQIT) W !
D CKP Q:$D(GMTSQIT) W !,$$REPEAT^XLFSTR("-",IOM-8)
D CKP Q:$D(GMTSQIT) W !,$$CJ^XLFSTR("SUPPLIES",IOM-8)
D CKP Q:$D(GMTSQIT) W !,$$REPEAT^XLFSTR("-",IOM-8)
D CKP Q:$D(GMTSQIT) W !
S LIST=2 D OUTPUT
Q
;
ADDREM ;USES RDI - REMOTE DATA INTEROPERABILITY TO INCORPORATE OUTSIDE MEDS
N DOWN,MED,RDI,RNAM,RNUM,STAT,ISSUE
Q:'$$HAVEHDR^ORRDI1
D Q:$G(DOWN) ;Check for outage of RDI
. I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) H $$GET^XPAR("ALL","ORRDI PING FREQ")/2
. I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) S DOWN=1 D Q:$D(GMTSQIT)
.. D CKP Q:$D(GMTSQIT)
.. W !,"WARNING: Connection to Remote Data Currently Down",!
.. D CKP
Q:$D(GMTSQIT)
;Get data for HFS file structure
D SAVDEV^%ZISUTL("GMTSHFS")
S RDI=$$GET^ORRDI1(DFN,"PSOO")
D USE^%ZISUTL("GMTSHFS")
D RMDEV^%ZISUTL("GMTSHFS")
;
H 1 ;One extra second to allow ^XTMP replication across nodes
I +RDI=-1 D Q:$D(GMTSQIT)
. D CKP Q:$D(GMTSQIT)
. W !,"WARNING: Connection to Remote Data Not Available",!
. D CKP
Q:'$D(^XTMP("ORRDI","PSOO",DFN))
S MED=0 F S MED=$O(^XTMP("ORRDI","PSOO",DFN,MED)) Q:'+MED D
. S STAT=$G(^XTMP("ORRDI","PSOO",DFN,MED,5,0))
. Q:STAT']""
. Q:"ACTIVE^SUSPENDED^HOLD"'[STAT
. ; GMTS*2.7*135 Commented out the next line
. ;Q:$G(^XTMP("ORRDI","PSOO",DFN,MED,7,0))']"" ;DoD:quit if there is no exp. date
. D Q:ISSUE<$$FMADD^XLFDT(DT,-366) ;DoD: quit if ISSUE DATE > 1Y ago
.. N %DT,X,Y
.. S X=$G(^XTMP("ORRDI","PSOO",DFN,MED,8,0))
.. D ^%DT
.. S ISSUE=+Y
. S RNAM=$G(^XTMP("ORRDI","PSOO",DFN,MED,2,0),"Unknown Drug")
. S RNUM=$G(^XTMP("ORRDI","PSOO",DFN,MED,4,0))
. Q:RNAM']""!(RNUM']"")
. S ALPHA(1,RNAM,RNUM,MED_"X;R")=""
Q
N NVADT,REPEAT
S NVADT=$$NVADT
D TEXTPRNT("HEADTXT1")
D CKP Q:$D(GMTSQIT)
W !,"Non-VA Meds Last Documented On: "
W $S(+NVADT:$$FMTE^XLFDT(NVADT,"D"),1:"** Data not found **")
D CKP Q:$D(GMTSQIT)
W !,$$REPEAT^XLFSTR("*",IOM-8)
D CKP Q:$D(GMTSQIT) W !
D CKP Q:$D(GMTSQIT)
D TEXTPRNT("HEADTXT2")
F REPEAT=1,2 D CKP Q:$D(GMTSQIT) W !
D CKP Q:$D(GMTSQIT)
W !,$$REPEAT^XLFSTR("-",IOM-8)
D CKP Q:$D(GMTSQIT)
Q
TEXTPRNT(TEXTLOC) ;PRINT LINES OF TEXT FROM A LINE LABEL, ENDS WITH $$END
N LINE,TLINE,LINETEXT
S LINE=0 F S LINE=LINE+1,TLINE=TEXTLOC_"+"_LINE,LINETEXT=$T(@TLINE) S LINETEXT=$E(LINETEXT,4,$L(LINETEXT)) Q:LINETEXT="$$END" D
. D CKP Q:$D(GMTSQIT)
. W !,LINETEXT
Q
OUTPUT N DRUGNM,ORDER,PSNUM
N PACK,PACKREF,SIGLINE,ORDNUM
N LASTACT,OTLINE
S DRUGNM="" F S DRUGNM=$O(ALPHA(LIST,DRUGNM)) Q:DRUGNM']"" D K SAVE(DRUGNM) Q:$D(GMTSQIT)
. S ORDER="" F S ORDER=$O(ALPHA(LIST,DRUGNM,ORDER)) Q:ORDER']"" D Q:$D(GMTSQIT)
.. S PSNUM="" F S PSNUM=$O(ALPHA(LIST,DRUGNM,ORDER,PSNUM)) Q:PSNUM']"" D Q:$D(GMTSQIT)
... S PACK=$P(PSNUM,";",2),ORDNUM=$P(PSNUM,";")
... I $$ISSUPPLY(,DRUGNM) S ALPHA(2,DRUGNM,ORDER,PSNUM)=ALPHA(LIST,DRUGNM,ORDER,PSNUM) Q
... I PACK="I" D INPDISP W ! Q:$D(GMTSQIT)
... I PACK="O" D OPTDISP W ! Q:$D(GMTSQIT)
... I PACK="R" D RDIDISP W ! Q:$D(GMTSQIT)
Q
INPDISP ;Display an Inpatient or Clinic Meds Entry
N GMTSPSTN,OALINE,OR0,ORIG,ORVP,PSIFN,WLINE,DIWL,DIWR,DIWF,TYPE,X,LASTBCMA,STATUS
N DDNUM,DRUGDISP,ORY
K ^UTILITY($J,"W")
D CKP Q:$D(GMTSQIT)
S STATUS=$G(ALPHA(LIST,DRUGNM,ORDER,PSNUM))
S STATUS=$S(STATUS["ACTIVE":"Active",STATUS["HOLD":"On Hold",STATUS["PENDING":"Pending",STATUS["DISCONTINUED":"Discontinued",1:STATUS)
;W !,$S($$ISCLIN^ORUTL1(ORDER):"CLIN ",1:"INPT ")_DRUGNM_" (Status="_STATUS_")"
D DRUGDSP
D IMOOD^ORIMO(.ORY,ORDER)
W !,$S(ORY:"CLIN ",1:"INPT ")_DRUGDISP_" (Status="_STATUS_")"
D CKP Q:$D(GMTSQIT)
D DRGDSP2
D TEXT^ORQ12(.GMTSPSTN,ORDER,80)
S DIWL=IND1,DIWR=60,ORIG=$S(PSNUM["U":2,$$GET1^DIQ(53.1,+PSNUM,4,"I")="U":2,1:1)
D:$E(GMTSPSTN(1),1,7)="Change "
. F OALINE=2:1:$O(GMTSPSTN(":"),-1) I $E(GMTSPSTN(OALINE),1,3)="to " S ORIG=OALINE,$E(GMTSPSTN(OALINE),1,3)="" Q
F OALINE=ORIG:1:$O(GMTSPSTN(":"),-1) D
. S X=$$LSIG($G(GMTSPSTN(OALINE)))
.; S X=$G(GMTSPSTN(OALINE))
. D ^DIWP
S WLINE=0 F S WLINE=$O(^UTILITY($J,"W",DIWL,WLINE)) Q:'+WLINE D Q:$D(GMTSQIT)
. W !?DIWL,$G(^UTILITY($J,"W",DIWL,WLINE,0))
. D CKP
Q:$D(GMTSQIT)
S LASTBCMA=$$BCMALG^PSJUTL2(DFN,ORDNUM)
I LASTBCMA'="" W !?IND1,$$BCMALG^PSJUTL2(DFN,ORDNUM) D CKP Q:$D(GMTSQIT)
Q
;
DRUGDSP ; Get Medication with Dosage
S PSIFN=$G(^OR(100,ORDER,4)),OR0=$G(^OR(100,ORDER,0))
S TYPE=$$GETPKG(ORDER)
S ORVP=$P(OR0,U,2) K ^TMP("PS",$J)
D OEL^PSOORRL(+ORVP,PSIFN_";"_TYPE) ; IA 2400
S DRUGDISP="" I $P($G(^TMP("PS",$J,"DD",1,0)),U,1)]"" D
. S DRUGDISP=$$GET1^DIQ(50,+$P(^TMP("PS",$J,"DD",1,0),U,1)_",",.01)
S DRUGDISP=$S(DRUGDISP]"":DRUGDISP,1:DRUGNM)
Q
;
DRGDSP2 ; Display other multiple information for medications/dosages
S DDNUM=1 F S DDNUM=$O(^TMP("PS",$J,"DD",DDNUM)) Q:DDNUM="" D Q:$D(GMTSQIT)
. S DRUGDISP=$$GET1^DIQ(50,+$P(^TMP("PS",$J,"DD",DDNUM,0),U,1)_",",.01)
. I DRUGDISP]"" W !," ",DRUGDISP D CKP
Q
;
OPTDISP ;Display an Outpatient Prescription Entry
N EXPDT,REFILLS,STATUS,DIWL,DIWR,PENDMED,GMTSPSTP,ORQLN,CANCELDT
N ORDTYP,ORIGRX,QDFLAG
K ^TMP($J,"GMTSPSTN"),^UTILITY($J,"W")
S PACKREF=$$PKGID^ORX8(ORDER)
I PACKREF["S" D Q
. D PEN^PSO5241(DFN,"GMTSPSTN",+PACKREF,ORDER)
. D CKP Q:$D(GMTSQIT)
. W !,"OUTPT "_DRUGNM_" (Status = Pending)"
. D CKP Q:$D(GMTSQIT)
. D TEXT^ORQ12(.GMTSPSTP,ORDER,60)
. ;p127 mwa stopped previous instructions from showing, stopped subscript error, and leading space error
. S ORQLN=1 F S ORQLN=$O(GMTSPSTP(ORQLN)) Q:'+ORQLN Q:$E(GMTSPSTP(ORQLN),1,3+$L($P(DRUGNM," ")))=("to "_$P(DRUGNM," "))
. S:ORQLN="" ORQLN=1
. F S ORQLN=$O(GMTSPSTP(ORQLN)) Q:'+ORQLN Q:(GMTSPSTP(ORQLN)?." "1"Quantity: ".E) D
.. W !?IND1,GMTSPSTP(ORQLN)
.. D CKP Q:$D(GMTSQIT)
. S ORIGRX=$P($G(^TMP($J,"GMTSPSTN",DFN,+PACKREF,22.1)),U,2)
. S ORDTYP=$P($G(^TMP($J,"GMTSPSTN",DFN,+PACKREF,2)),U,1)
. S QDFLAG=0 I ORIGRX]"",ORDTYP="RNW" D
.. W !?10,"Renewed from Rx# "_ORIGRX
.. D CKP Q:$D(GMTSQIT)
.. W ?50,"Qty/Days Supply: "_$G(^TMP($J,"GMTSPSTN",DFN,+PACKREF,12))_"/"_$G(^TMP($J,"GMTSPSTN",DFN,+PACKREF,101))
.. S QDFLAG=1
. D CKP Q:$D(GMTSQIT)
. W !?10,"Login Date: "_$$FMTE^XLFDT(+$G(^TMP($J,"GMTSPSTN",DFN,+PACKREF,15)),"2D")
. D CKP Q:$D(GMTSQIT)
. I 'QDFLAG D
.. W ?50,"Qty/Days Supply: "_$G(^TMP($J,"GMTSPSTN",DFN,+PACKREF,12))_"/"_$G(^TMP($J,"GMTSPSTN",DFN,+PACKREF,101))
.. D CKP Q:$D(GMTSQIT)
. W:'QDFLAG ! W ?50,"Refills Ordered: "_$G(^TMP($J,"GMTSPSTN",DFN,+PACKREF,13))
. D CKP Q:$D(GMTSQIT)
. W !
D RX^PSO52API(DFN,"GMTSPSTN",PACKREF)
S EXPDT=$G(^TMP($J,"GMTSPSTN",DFN,PACKREF,26))
S CANCELDT=$G(^TMP($J,"GMTSPSTN",DFN,PACKREF,26.1))
S REFILLS=$G(^TMP($J,"GMTSPSTN",DFN,PACKREF,9))-$S($G(^TMP($J,"GMTSPSTN",DFN,PACKREF,"RF",0))>0:$G(^TMP($J,"GMTSPSTN",DFN,PACKREF,"RF",0)),1:0) ;need to make sure this is as accurate as the previous method in PSOQ0076
S LASTREL=$$LRD(PACKREF)
I $P(PSNUM,";")["N" G NVADISP
I EXPDT Q:$$FMDIFF^XLFDT(DT,$P(EXPDT,U))>EXPDAYS
I CANCELDT Q:$$FMDIFF^XLFDT(DT,$P(CANCELDT,U))>EXPDAYS
S STATUS=$P($G(^TMP($J,"GMTSPSTN",DFN,PACKREF,100)),U,2)
S STATUS=$S(STATUS["PARK":"Active/Parked",STATUS["ACTIVE":"Active",STATUS["SUSPENDED":"Active/Suspended",STATUS["HOLD":"On Hold",STATUS["DISCONTINUED":"Discontinued",1:STATUS)
D CKP Q:$D(GMTSQIT)
W !,"OUTPT "_DRUGNM_" (Status = "_STATUS_")"
S DIWL=IND1,DIWR=72
S SIGLINE=0 F S SIGLINE=$O(^TMP($J,"GMTSPSTN",DFN,PACKREF,"M",SIGLINE)) Q:'+SIGLINE D Q:$D(GMTSQIT)
. S X=$G(^TMP($J,"GMTSPSTN",DFN,PACKREF,"M",SIGLINE,0))
. D ^DIWP
S WLINE=0 F S WLINE=$O(^UTILITY($J,"W",DIWL,WLINE)) Q:'+WLINE!($D(GMTSQIT)) D Q:$D(GMTSQIT)
. W !?DIWL,$G(^UTILITY($J,"W",DIWL,WLINE,0))
. D CKP
Q:$D(GMTSQIT)
W !?10,"Rx# "_$G(^TMP($J,"GMTSPSTN",DFN,PACKREF,.01))_" Last Released: "_$$FMTE^XLFDT(LASTREL,"2D"),?50,"Qty/Days Supply: "_$G(^TMP($J,"GMTSPSTN",DFN,PACKREF,7))_"/"_$G(^TMP($J,"GMTSPSTN",DFN,PACKREF,8)) D CKP Q:$D(GMTSQIT)
W !?10,"Rx Expiration Date: ",$$FMTE^XLFDT(EXPDT,"2D"),?50,"Refills Remaining: ",REFILLS D CKP Q:$D(GMTSQIT)
W:$P($G(^TMP($J,"GMTSPSTN",DFN,PACKREF,"IND")),U)]"" !?10,"Indication: "_$P(^TMP($J,"GMTSPSTN",DFN,PACKREF,"IND"),U)
W ! D CKP
Q
;
ISSUPPLY(DRUG,DRUGNAME) ;
; Function returns '1' if drug is a SUPPLY, '0' otherwise
Q:LIST=2 0 ;Only check during regular med list, not in supply list
N VACLASS,DEAHDLG
K ^TMP($J,"GMTSPSTND")
I +$G(DRUG) D DATA^PSS50(DRUG,,,,,"GMTSPSTND")
E D DATA^PSS50(,DRUGNAME,,,,"GMTSPSTND") S DRUG=$O(^TMP($J,"GMTSPSTND",0))
I 'DRUG Q 0
S VACLASS=$G(^TMP($J,"GMTSPSTND",DRUG,2))
S DEAHDLG=$G(^TMP($J,"GMTSPSTND",DRUG,3))
Q:$E(VACLASS,1,2)="XA" 1
Q:$E(VACLASS,1,2)="XX" 1
Q:(VACLASS="DX900")&(DEAHDLG["S") 1
Q 0
;
RDIDISP ;Display a Remote Meds Entry
D CKP Q:$D(GMTSQIT)
W !,"Remote ",?IND1,DRUGNM D CKP Q:$D(GMTSQIT)
N STATUS,DIWL,DIWR,DIWF,X,WLINE
K ^UTILITY($J,"W")
S X=$G(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,14,0)),DIWL=IND1,DIWR=60
D ^DIWP
S WLINE=0 F S WLINE=$O(^UTILITY($J,"W",DIWL,WLINE)) Q:'+WLINE D Q:$D(GMTSQIT)
. D CKP Q:$D(GMTSQIT)
. W !?DIWL,$G(^UTILITY($J,"W",DIWL,WLINE,0))
D CKP Q:$D(GMTSQIT)
S STATUS=$G(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,5,0))
S STATUS=$S(STATUS["ACTIVE":"Active",STATUS["SUSPENDED":"Active/Suspended",STATUS["HOLD":"Hold",1:"Unknown")
W !?10,"Last Filled: "_$G(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,9,0))_" ("_STATUS_" at "_$G(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,1,0))_") "
W !?10,"Rx Expiration Date: ",$G(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,7,0)),?55,"Days Supply: "_$P($P($G(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,6,0)),";",2),"D",2)
Q
;
NVADISP ;Display a Non-VA Medication Entry
N GMTSPSTN,OALINE,ORIG,WLINE,DIWL,DIWR,DIWF,X
K ^UTILITY($J,"W")
D CKP Q:$D(GMTSQIT)
W !,"Non-VA "_DRUGNM D CKP Q:$D(GMTSQIT)
D TEXT^ORQ12(.GMTSPSTN,ORDER,80)
S DIWL=IND1,DIWR=60,ORIG=2
D:$E(GMTSPSTN(1),1,14)="Non-VA Change "
. F OALINE=2:1:$O(GMTSPSTN(":"),-1) I $E(GMTSPSTN(OALINE),1,3)="to " S ORIG=OALINE+1 Q
F OALINE=ORIG:1:$O(GMTSPSTN(":"),-1) D
. S X=$$LSIG($G(GMTSPSTN(OALINE)))
. D ^DIWP
S WLINE=0 F S WLINE=$O(^UTILITY($J,"W",DIWL,WLINE)) Q:'+WLINE D Q:$D(GMTSQIT)
. W !?DIWL,$G(^UTILITY($J,"W",DIWL,WLINE,0))
. D CKP
W ! D CKP Q:$D(GMTSQIT)
Q
D CKP Q:$D(GMTSQIT) W !
D TEXTPRNT("FOOTER1")
Q
N LASTREL,FOOTTXT,DAYSSUPP,STATUS
K ^TMP($J,"GMTSPSTN")
S PACKREF=$$PKGID^ORX8(ORDER)
S LASTREL=$$LRD(PACKREF)
Q:LASTREL<$$FMADD^XLFDT(DT,-365)
Q:$P(PSNUM,";")["N"
D CKP Q:$D(GMTSQIT)
W !,"OPT "_DRUGNM D CKP Q:$D(GMTSQIT)
D RX^PSO52API(DFN,"GMTSPSTN",PACKREF)
S STATUS=$P($G(^TMP($J,"GMTSPSTN",DFN,PACKREF,100)),U,2)
S DAYSSUPP=$G(^TMP($J,"GMTSPSTN",DFN,PACKREF,8))
S FOOTTXT="("_STATUS_"/"_DAYSSUPP_" Days Supply Last Released: "_$$FMTE^XLFDT(LASTREL,"2D")_")"
W $$RJ^XLFSTR(FOOTTXT,74) D CKP Q:$D(GMTSQIT)
S SIGLINE=0 F S SIGLINE=$O(^TMP($J,"GMTSPSTN",DFN,PACKREF,"M",SIGLINE)) Q:'+SIGLINE D Q:$D(GMTSQIT)
. W !?IND1,$G(^TMP($J,"GMTSPSTN",DFN,PACKREF,"M",SIGLINE,0))
. D CKP
D CKP
Q
NVADT() ;Replaces call previously in ^PSOQCF04
N NVAL,NVARR
D ^PSOHCSUM
Q:'$D(^TMP("PSOO",$J,"NVA")) ""
S NVAL=0 F S NVAL=$O(^TMP("PSOO",$J,"NVA",NVAL)) Q:'+NVAL D
. S NVADT=9999999-$P($G(^TMP("PSOO",$J,"NVA",NVAL,0)),"^",5)
. S NVARR(NVADT)=""
S NVADT=$O(NVARR(0)) Q:NVADT=9999999 ""
Q 9999999-NVADT
LSIG(SIG) ;Expand a SIG
N P,SGY,X,%
S SGY="" F P=1:1:$L(SIG," ") S X=$P(SIG," ",P) D:X]"" ;
.I $D(^PS(51,"A",X)) S %=^(X),X=$P(%,"^") I $P(%,"^",2)]"" S Y=$P(SIG," ",P-1),Y=$E(Y,$L(Y)) S:Y>1 X=$P(%,"^",2)
.S SGY=SGY_X_" "
Q SGY
LRD(PACKREF) ;Calculate LAST RELEASE DATE as latest of original + refill relDates
N RELDT,REFDT,CTR,ANS
K ^TMP($J,"GMTSLRD")
S ANS=""
D RX^PSO52API(DFN,"GMTSLRD",PACKREF,,"3,R")
S RELDT=$G(^TMP($J,"GMTSLRD",DFN,PACKREF,31))
S ANS=RELDT
S CTR=0 F S CTR=$O(^TMP($J,"GMTSLRD",DFN,PACKREF,"RF",CTR)) Q:'+CTR D ;
. S REFDT=$G(^TMP($J,"GMTSLRD",DFN,PACKREF,"RF",CTR,17))
. I REFDT>ANS S ANS=REFDT
K ^TMP($J,"GMTSLRD")
Q ANS
;
CKP D CKP^GMTSUP Q
;
GETPKG(ORDER) ;GET PACKAGE TYPE, added by GMTS*2.7*132
N PKGIEN,PKGTYPE
S PKGIEN=$$GET1^DIQ(100,ORDER_",",12,"I")
S PKGTYPE=$$GET1^DIQ(9.4,PKGIEN_",",.01,"I")
I PKGTYPE="INPATIENT MEDICATIONS" Q "I"
I PKGTYPE="OUTPATIENT PHARMACY" Q "O"
Q $$GET1^DIQ(100,ORDER_",",10,"I")
HEADTXT1 ;;
;;INCLUDED IN THIS LIST: Alphabetical list of active outpatient
;;prescriptions dispensed from this VA (local) and dispensed from another
;;VA or DoD facility (remote) as well as inpatient orders (local pending and
;;active), local clinic medications, locally documented non-VA medications,
;;and local prescriptions that have expired or been discontinued in the past
;;90 days.
;;
;;$$END
HEADTXT2 ;;
;;***NOTE*** The display of VA prescriptions dispensed from another VA or
;;DoD facility (remote) is limited to active outpatient prescription entries
;;matched to National Drug File at the originating site and may not include
;;some items such as investigational drugs, compounds, etc.
;;
;;NOT INCLUDED IN THIS LIST: Medications self-entered by the patient into
;;personal health records (i.e. My HealtheVet) are NOT included in this
;;list. Non-VA medications documented outside this VA, remote inpatient
;;orders (regardless of status) and remote clinic medications are NOT
;;included in this list. The patient and provider must always discuss
;;medications the patient is taking, regardless of where the medication was
;;dispensed or obtained.
;;$$END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPSTN 15209 printed Nov 22, 2024@17:09:50 Page 2
GMTSPSTN ;BIR/RMS - MED RECON TOOL #1 NO GLOSSARY (MED REC PROFILE) ; Jan 31, 2023@12:50:10
+1 ;;2.7;Health Summary;**94,127,131,132,135,115,145**;Oct 20, 1995;Build 191
+2 ;
+3 ; Reference to COVER^ORWPS in ICR #7392
+4 ; Reference to $$GET^ORRDI1,$$HAVEHDR^ORRDI1 in ICR #4659
+5 ; Reference to ^XTMP("ORRDI","PSOO" in ICR #4660
+6 ; Reference to ^XTMP("ORRDI","OUTAGE INFO" in ICR #5440
+7 ; Reference to ^PSOHCSUM in ICR #330
+8 ; Reference to $$ISCLIN^ORUTL1 in ICR #5691
+9 ; Reference to ^OR(100 in ICR #5771
+10 ; Reference to ^PS(51 in ICR #1980
+11 ; Reference to ^PS(53.1 in ICR #534
+12 ; Reference to TEXT^ORQ12 in ICR #4202
+13 ; Reference to $$PKGID^ORX8 in ICR #3071
+14 ; Reference to BCMALG^PSJUTL2 in ICR #5057
+15 ; Reference to OEL^PSOORRL in ICR #2400
+16 ; Reference to IMOOD^ORIMO in ICR #7389
TOOL1 ;ENTRY POINT FOR HEALTH SUMMARY
+1 NEW ALPHA,DRUGNM,EXPDAYS,IND1,LIST,ORDER,PSNUM,RPC,RPCT,RPCNODE,SAVE,SAVERD
+2 DO ADD^GMTSPSTR("GMTSPSTN")
+3 SET IND1=7
SET EXPDAYS=90
+4 DO COVER^ORWPS(.RPC,DFN)
+5 SET RPCT=0
FOR
SET RPCT=$ORDER(RPC(RPCT))
if '+RPCT
QUIT
Begin DoDot:1
+6 SET RPCNODE=RPC(RPCT)
+7 SET PSNUM=$PIECE(RPCNODE,U)
+8 SET DRUGNM=$$UP^XLFSTR($PIECE(RPCNODE,U,2))
+9 SET ORDER=+$PIECE(RPCNODE,U,3)
+10 if DRUGNM']""!(ORDER=0)!(PSNUM']"")
QUIT
+11 SET SAVERD=9999999-$$LRD(+$GET(^OR(100,ORDER,4)))
+12 SET SAVE(DRUGNM,SAVERD,ORDER,PSNUM)=""
+13 if ("ACTIVE^ACTIVE/SUSP^ACTIVE/PARKED^HOLD^PENDING^ON CALL"'[$PIECE(RPCNODE,U,4))&($PIECE(PSNUM,";")["N")
QUIT
+14 SET ALPHA(1,DRUGNM,ORDER,PSNUM)=$PIECE(RPCNODE,U,4)
End DoDot:1
+15 DO ADDREM
+16 DO HEADER
+17 SET LIST=1
DO OUTPUT
+18 DO CKP
if $DATA(GMTSQIT)
QUIT
WRITE !
+19 DO CKP
if $DATA(GMTSQIT)
QUIT
WRITE !,$$REPEAT^XLFSTR("-",IOM-8)
+20 DO CKP
if $DATA(GMTSQIT)
QUIT
WRITE !,$$CJ^XLFSTR("SUPPLIES",IOM-8)
+21 DO CKP
if $DATA(GMTSQIT)
QUIT
WRITE !,$$REPEAT^XLFSTR("-",IOM-8)
+22 DO CKP
if $DATA(GMTSQIT)
QUIT
WRITE !
+23 SET LIST=2
DO OUTPUT
+24 QUIT
+25 ;
ADDREM ;USES RDI - REMOTE DATA INTEROPERABILITY TO INCORPORATE OUTSIDE MEDS
+1 NEW DOWN,MED,RDI,RNAM,RNUM,STAT,ISSUE
+2 if '$$HAVEHDR^ORRDI1
QUIT
+3 ;Check for outage of RDI
Begin DoDot:1
+4 IF $DATA(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
HANG $$GET^XPAR("ALL","ORRDI PING FREQ")/2
+5 IF $DATA(^XTMP("ORRDI","OUTAGE INFO","DOWN"))
SET DOWN=1
Begin DoDot:2
+6 DO CKP
if $DATA(GMTSQIT)
QUIT
+7 WRITE !,"WARNING: Connection to Remote Data Currently Down",!
+8 DO CKP
End DoDot:2
if $DATA(GMTSQIT)
QUIT
End DoDot:1
if $GET(DOWN)
QUIT
+9 if $DATA(GMTSQIT)
QUIT
+10 ;Get data for HFS file structure
+11 DO SAVDEV^%ZISUTL("GMTSHFS")
+12 SET RDI=$$GET^ORRDI1(DFN,"PSOO")
+13 DO USE^%ZISUTL("GMTSHFS")
+14 DO RMDEV^%ZISUTL("GMTSHFS")
+15 ;
+16 ;One extra second to allow ^XTMP replication across nodes
HANG 1
+17 IF +RDI=-1
Begin DoDot:1
+18 DO CKP
if $DATA(GMTSQIT)
QUIT
+19 WRITE !,"WARNING: Connection to Remote Data Not Available",!
+20 DO CKP
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+21 if '$DATA(^XTMP("ORRDI","PSOO",DFN))
QUIT
+22 SET MED=0
FOR
SET MED=$ORDER(^XTMP("ORRDI","PSOO",DFN,MED))
if '+MED
QUIT
Begin DoDot:1
+23 SET STAT=$GET(^XTMP("ORRDI","PSOO",DFN,MED,5,0))
+24 if STAT']""
QUIT
+25 if "ACTIVE^SUSPENDED^HOLD"'[STAT
QUIT
+26 ; GMTS*2.7*135 Commented out the next line
+27 ;Q:$G(^XTMP("ORRDI","PSOO",DFN,MED,7,0))']"" ;DoD:quit if there is no exp. date
+28 ;DoD: quit if ISSUE DATE > 1Y ago
Begin DoDot:2
+29 NEW %DT,X,Y
+30 SET X=$GET(^XTMP("ORRDI","PSOO",DFN,MED,8,0))
+31 DO ^%DT
+32 SET ISSUE=+Y
End DoDot:2
if ISSUE<$$FMADD^XLFDT(DT,-366)
QUIT
+33 SET RNAM=$GET(^XTMP("ORRDI","PSOO",DFN,MED,2,0),"Unknown Drug")
+34 SET RNUM=$GET(^XTMP("ORRDI","PSOO",DFN,MED,4,0))
+35 if RNAM']""!(RNUM']"")
QUIT
+36 SET ALPHA(1,RNAM,RNUM,MED_"X;R")=""
End DoDot:1
+37 QUIT
+1 NEW NVADT,REPEAT
+2 SET NVADT=$$NVADT
+3 DO TEXTPRNT("HEADTXT1")
+4 DO CKP
if $DATA(GMTSQIT)
QUIT
+5 WRITE !,"Non-VA Meds Last Documented On: "
+6 WRITE $SELECT(+NVADT:$$FMTE^XLFDT(NVADT,"D"),1:"** Data not found **")
+7 DO CKP
if $DATA(GMTSQIT)
QUIT
+8 WRITE !,$$REPEAT^XLFSTR("*",IOM-8)
+9 DO CKP
if $DATA(GMTSQIT)
QUIT
WRITE !
+10 DO CKP
if $DATA(GMTSQIT)
QUIT
+11 DO TEXTPRNT("HEADTXT2")
+12 FOR REPEAT=1,2
DO CKP
if $DATA(GMTSQIT)
QUIT
WRITE !
+13 DO CKP
if $DATA(GMTSQIT)
QUIT
+14 WRITE !,$$REPEAT^XLFSTR("-",IOM-8)
+15 DO CKP
if $DATA(GMTSQIT)
QUIT
+16 QUIT
TEXTPRNT(TEXTLOC) ;PRINT LINES OF TEXT FROM A LINE LABEL, ENDS WITH $$END
+1 NEW LINE,TLINE,LINETEXT
+2 SET LINE=0
FOR
SET LINE=LINE+1
SET TLINE=TEXTLOC_"+"_LINE
SET LINETEXT=$TEXT(@TLINE)
SET LINETEXT=$EXTRACT(LINETEXT,4,$LENGTH(LINETEXT))
if LINETEXT="$$END"
QUIT
Begin DoDot:1
+3 DO CKP
if $DATA(GMTSQIT)
QUIT
+4 WRITE !,LINETEXT
End DoDot:1
+5 QUIT
OUTPUT NEW DRUGNM,ORDER,PSNUM
+1 NEW PACK,PACKREF,SIGLINE,ORDNUM
+2 NEW LASTACT,OTLINE
+3 SET DRUGNM=""
FOR
SET DRUGNM=$ORDER(ALPHA(LIST,DRUGNM))
if DRUGNM']""
QUIT
Begin DoDot:1
+4 SET ORDER=""
FOR
SET ORDER=$ORDER(ALPHA(LIST,DRUGNM,ORDER))
if ORDER']""
QUIT
Begin DoDot:2
+5 SET PSNUM=""
FOR
SET PSNUM=$ORDER(ALPHA(LIST,DRUGNM,ORDER,PSNUM))
if PSNUM']""
QUIT
Begin DoDot:3
+6 SET PACK=$PIECE(PSNUM,";",2)
SET ORDNUM=$PIECE(PSNUM,";")
+7 IF $$ISSUPPLY(,DRUGNM)
SET ALPHA(2,DRUGNM,ORDER,PSNUM)=ALPHA(LIST,DRUGNM,ORDER,PSNUM)
QUIT
+8 IF PACK="I"
DO INPDISP
WRITE !
if $DATA(GMTSQIT)
QUIT
+9 IF PACK="O"
DO OPTDISP
WRITE !
if $DATA(GMTSQIT)
QUIT
+10 IF PACK="R"
DO RDIDISP
WRITE !
if $DATA(GMTSQIT)
QUIT
End DoDot:3
if $DATA(GMTSQIT)
QUIT
End DoDot:2
if $DATA(GMTSQIT)
QUIT
End DoDot:1
KILL SAVE(DRUGNM)
if $DATA(GMTSQIT)
QUIT
+11 QUIT
INPDISP ;Display an Inpatient or Clinic Meds Entry
+1 NEW GMTSPSTN,OALINE,OR0,ORIG,ORVP,PSIFN,WLINE,DIWL,DIWR,DIWF,TYPE,X,LASTBCMA,STATUS
+2 NEW DDNUM,DRUGDISP,ORY
+3 KILL ^UTILITY($JOB,"W")
+4 DO CKP
if $DATA(GMTSQIT)
QUIT
+5 SET STATUS=$GET(ALPHA(LIST,DRUGNM,ORDER,PSNUM))
+6 SET STATUS=$SELECT(STATUS["ACTIVE":"Active",STATUS["HOLD":"On Hold",STATUS["PENDING":"Pending",STATUS["DISCONTINUED":"Discontinued",1:STATUS)
+7 ;W !,$S($$ISCLIN^ORUTL1(ORDER):"CLIN ",1:"INPT ")_DRUGNM_" (Status="_STATUS_")"
+8 DO DRUGDSP
+9 DO IMOOD^ORIMO(.ORY,ORDER)
+10 WRITE !,$SELECT(ORY:"CLIN ",1:"INPT ")_DRUGDISP_" (Status="_STATUS_")"
+11 DO CKP
if $DATA(GMTSQIT)
QUIT
+12 DO DRGDSP2
+13 DO TEXT^ORQ12(.GMTSPSTN,ORDER,80)
+14 SET DIWL=IND1
SET DIWR=60
SET ORIG=$SELECT(PSNUM["U":2,$$GET1^DIQ(53.1,+PSNUM,4,"I")="U":2,1:1)
+15 if $EXTRACT(GMTSPSTN(1),1,7)="Change "
Begin DoDot:1
+16 FOR OALINE=2:1:$ORDER(GMTSPSTN(":"),-1)
IF $EXTRACT(GMTSPSTN(OALINE),1,3)="to "
SET ORIG=OALINE
SET $EXTRACT(GMTSPSTN(OALINE),1,3)=""
QUIT
End DoDot:1
+17 FOR OALINE=ORIG:1:$ORDER(GMTSPSTN(":"),-1)
Begin DoDot:1
+18 SET X=$$LSIG($GET(GMTSPSTN(OALINE)))
+19 ; S X=$G(GMTSPSTN(OALINE))
+20 DO ^DIWP
End DoDot:1
+21 SET WLINE=0
FOR
SET WLINE=$ORDER(^UTILITY($JOB,"W",DIWL,WLINE))
if '+WLINE
QUIT
Begin DoDot:1
+22 WRITE !?DIWL,$GET(^UTILITY($JOB,"W",DIWL,WLINE,0))
+23 DO CKP
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+24 if $DATA(GMTSQIT)
QUIT
+25 SET LASTBCMA=$$BCMALG^PSJUTL2(DFN,ORDNUM)
+26 IF LASTBCMA'=""
WRITE !?IND1,$$BCMALG^PSJUTL2(DFN,ORDNUM)
DO CKP
if $DATA(GMTSQIT)
QUIT
+27 QUIT
+28 ;
DRUGDSP ; Get Medication with Dosage
+1 SET PSIFN=$GET(^OR(100,ORDER,4))
SET OR0=$GET(^OR(100,ORDER,0))
+2 SET TYPE=$$GETPKG(ORDER)
+3 SET ORVP=$PIECE(OR0,U,2)
KILL ^TMP("PS",$JOB)
+4 ; IA 2400
DO OEL^PSOORRL(+ORVP,PSIFN_";"_TYPE)
+5 SET DRUGDISP=""
IF $PIECE($GET(^TMP("PS",$JOB,"DD",1,0)),U,1)]""
Begin DoDot:1
+6 SET DRUGDISP=$$GET1^DIQ(50,+$PIECE(^TMP("PS",$JOB,"DD",1,0),U,1)_",",.01)
End DoDot:1
+7 SET DRUGDISP=$SELECT(DRUGDISP]"":DRUGDISP,1:DRUGNM)
+8 QUIT
+9 ;
DRGDSP2 ; Display other multiple information for medications/dosages
+1 SET DDNUM=1
FOR
SET DDNUM=$ORDER(^TMP("PS",$JOB,"DD",DDNUM))
if DDNUM=""
QUIT
Begin DoDot:1
+2 SET DRUGDISP=$$GET1^DIQ(50,+$PIECE(^TMP("PS",$JOB,"DD",DDNUM,0),U,1)_",",.01)
+3 IF DRUGDISP]""
WRITE !," ",DRUGDISP
DO CKP
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+4 QUIT
+5 ;
OPTDISP ;Display an Outpatient Prescription Entry
+1 NEW EXPDT,REFILLS,STATUS,DIWL,DIWR,PENDMED,GMTSPSTP,ORQLN,CANCELDT
+2 NEW ORDTYP,ORIGRX,QDFLAG
+3 KILL ^TMP($JOB,"GMTSPSTN"),^UTILITY($JOB,"W")
+4 SET PACKREF=$$PKGID^ORX8(ORDER)
+5 IF PACKREF["S"
Begin DoDot:1
+6 DO PEN^PSO5241(DFN,"GMTSPSTN",+PACKREF,ORDER)
+7 DO CKP
if $DATA(GMTSQIT)
QUIT
+8 WRITE !,"OUTPT "_DRUGNM_" (Status = Pending)"
+9 DO CKP
if $DATA(GMTSQIT)
QUIT
+10 DO TEXT^ORQ12(.GMTSPSTP,ORDER,60)
+11 ;p127 mwa stopped previous instructions from showing, stopped subscript error, and leading space error
+12 SET ORQLN=1
FOR
SET ORQLN=$ORDER(GMTSPSTP(ORQLN))
if '+ORQLN
QUIT
if $EXTRACT(GMTSPSTP(ORQLN),1,3+$LENGTH($PIECE(DRUGNM," ")))=("to "_$PIECE(DRUGNM," "))
QUIT
+13 if ORQLN=""
SET ORQLN=1
+14 FOR
SET ORQLN=$ORDER(GMTSPSTP(ORQLN))
if '+ORQLN
QUIT
if (GMTSPSTP(ORQLN)?." "1"Quantity
QUIT
Begin DoDot:2
+15 WRITE !?IND1,GMTSPSTP(ORQLN)
+16 DO CKP
if $DATA(GMTSQIT)
QUIT
End DoDot:2
+17 SET ORIGRX=$PIECE($GET(^TMP($JOB,"GMTSPSTN",DFN,+PACKREF,22.1)),U,2)
+18 SET ORDTYP=$PIECE($GET(^TMP($JOB,"GMTSPSTN",DFN,+PACKREF,2)),U,1)
+19 SET QDFLAG=0
IF ORIGRX]""
IF ORDTYP="RNW"
Begin DoDot:2
+20 WRITE !?10,"Renewed from Rx# "_ORIGRX
+21 DO CKP
if $DATA(GMTSQIT)
QUIT
+22 WRITE ?50,"Qty/Days Supply: "_$GET(^TMP($JOB,"GMTSPSTN",DFN,+PACKREF,12))_"/"_$GET(^TMP($JOB,"GMTSPSTN",DFN,+PACKREF,101))
+23 SET QDFLAG=1
End DoDot:2
+24 DO CKP
if $DATA(GMTSQIT)
QUIT
+25 WRITE !?10,"Login Date: "_$$FMTE^XLFDT(+$GET(^TMP($JOB,"GMTSPSTN",DFN,+PACKREF,15)),"2D")
+26 DO CKP
if $DATA(GMTSQIT)
QUIT
+27 IF 'QDFLAG
Begin DoDot:2
+28 WRITE ?50,"Qty/Days Supply: "_$GET(^TMP($JOB,"GMTSPSTN",DFN,+PACKREF,12))_"/"_$GET(^TMP($JOB,"GMTSPSTN",DFN,+PACKREF,101))
+29 DO CKP
if $DATA(GMTSQIT)
QUIT
End DoDot:2
+30 if 'QDFLAG
WRITE !
WRITE ?50,"Refills Ordered: "_$GET(^TMP($JOB,"GMTSPSTN",DFN,+PACKREF,13))
+31 DO CKP
if $DATA(GMTSQIT)
QUIT
+32 WRITE !
End DoDot:1
QUIT
+33 DO RX^PSO52API(DFN,"GMTSPSTN",PACKREF)
+34 SET EXPDT=$GET(^TMP($JOB,"GMTSPSTN",DFN,PACKREF,26))
+35 SET CANCELDT=$GET(^TMP($JOB,"GMTSPSTN",DFN,PACKREF,26.1))
+36 ;need to make sure this is as accurate as the previous method in PSOQ0076
SET REFILLS=$GET(^TMP($JOB,"GMTSPSTN",DFN,PACKREF,9))-$SELECT($GET(^TMP($JOB,"GMTSPSTN",DFN,PACKREF,"RF",0))>0:$GET(^TMP($JOB,"GMTSPSTN",DFN,PACKREF,"RF",0)),1:0)
+37 SET LASTREL=$$LRD(PACKREF)
+38 IF $PIECE(PSNUM,";")["N"
GOTO NVADISP
+39 IF EXPDT
if $$FMDIFF^XLFDT(DT,$PIECE(EXPDT,U))>EXPDAYS
QUIT
+40 IF CANCELDT
if $$FMDIFF^XLFDT(DT,$PIECE(CANCELDT,U))>EXPDAYS
QUIT
+41 SET STATUS=$PIECE($GET(^TMP($JOB,"GMTSPSTN",DFN,PACKREF,100)),U,2)
+42 SET STATUS=$SELECT(STATUS["PARK":"Active/Parked",STATUS["ACTIVE":"Active",STATUS["SUSPENDED":"Active/Suspended",STATUS["HOLD":"On Hold",STATUS["DISCONTINUED":"Discontinued",1:STATUS)
+43 DO CKP
if $DATA(GMTSQIT)
QUIT
+44 WRITE !,"OUTPT "_DRUGNM_" (Status = "_STATUS_")"
+45 SET DIWL=IND1
SET DIWR=72
+46 SET SIGLINE=0
FOR
SET SIGLINE=$ORDER(^TMP($JOB,"GMTSPSTN",DFN,PACKREF,"M",SIGLINE))
if '+SIGLINE
QUIT
Begin DoDot:1
+47 SET X=$GET(^TMP($JOB,"GMTSPSTN",DFN,PACKREF,"M",SIGLINE,0))
+48 DO ^DIWP
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+49 SET WLINE=0
FOR
SET WLINE=$ORDER(^UTILITY($JOB,"W",DIWL,WLINE))
if '+WLINE!($DATA(GMTSQIT))
QUIT
Begin DoDot:1
+50 WRITE !?DIWL,$GET(^UTILITY($JOB,"W",DIWL,WLINE,0))
+51 DO CKP
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+52 if $DATA(GMTSQIT)
QUIT
+53 WRITE !?10,"Rx# "_$GET(^TMP($JOB,"GMTSPSTN",DFN,PACKREF,.01))_" Last Released: "_$$FMTE^XLFDT(LASTREL,"2D"),?50,"Qty/Days Supply: "_$GET(^TMP($JOB,"GMTSPSTN",DFN,PACKREF,7))_"/"_$GET(^TMP($JOB,"GMTSPSTN",DFN,PACKREF,8))
DO CKP
if $DATA(GMTSQIT)
QUIT
+54 WRITE !?10,"Rx Expiration Date: ",$$FMTE^XLFDT(EXPDT,"2D"),?50,"Refills Remaining: ",REFILLS
DO CKP
if $DATA(GMTSQIT)
QUIT
+55 if $PIECE($GET(^TMP($JOB,"GMTSPSTN",DFN,PACKREF,"IND")),U)]""
WRITE !?10,"Indication: "_$PIECE(^TMP($JOB,"GMTSPSTN",DFN,PACKREF,"IND"),U)
+56 WRITE !
DO CKP
+57 QUIT
+58 ;
ISSUPPLY(DRUG,DRUGNAME) ;
+1 ; Function returns '1' if drug is a SUPPLY, '0' otherwise
+2 ;Only check during regular med list, not in supply list
if LIST=2
QUIT 0
+3 NEW VACLASS,DEAHDLG
+4 KILL ^TMP($JOB,"GMTSPSTND")
+5 IF +$GET(DRUG)
DO DATA^PSS50(DRUG,,,,,"GMTSPSTND")
+6 IF '$TEST
DO DATA^PSS50(,DRUGNAME,,,,"GMTSPSTND")
SET DRUG=$ORDER(^TMP($JOB,"GMTSPSTND",0))
+7 IF 'DRUG
QUIT 0
+8 SET VACLASS=$GET(^TMP($JOB,"GMTSPSTND",DRUG,2))
+9 SET DEAHDLG=$GET(^TMP($JOB,"GMTSPSTND",DRUG,3))
+10 if $EXTRACT(VACLASS,1,2)="XA"
QUIT 1
+11 if $EXTRACT(VACLASS,1,2)="XX"
QUIT 1
+12 if (VACLASS="DX900")&(DEAHDLG["S")
QUIT 1
+13 QUIT 0
+14 ;
RDIDISP ;Display a Remote Meds Entry
+1 DO CKP
if $DATA(GMTSQIT)
QUIT
+2 WRITE !,"Remote ",?IND1,DRUGNM
DO CKP
if $DATA(GMTSQIT)
QUIT
+3 NEW STATUS,DIWL,DIWR,DIWF,X,WLINE
+4 KILL ^UTILITY($JOB,"W")
+5 SET X=$GET(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,14,0))
SET DIWL=IND1
SET DIWR=60
+6 DO ^DIWP
+7 SET WLINE=0
FOR
SET WLINE=$ORDER(^UTILITY($JOB,"W",DIWL,WLINE))
if '+WLINE
QUIT
Begin DoDot:1
+8 DO CKP
if $DATA(GMTSQIT)
QUIT
+9 WRITE !?DIWL,$GET(^UTILITY($JOB,"W",DIWL,WLINE,0))
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+10 DO CKP
if $DATA(GMTSQIT)
QUIT
+11 SET STATUS=$GET(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,5,0))
+12 SET STATUS=$SELECT(STATUS["ACTIVE":"Active",STATUS["SUSPENDED":"Active/Suspended",STATUS["HOLD":"Hold",1:"Unknown")
+13 WRITE !?10,"Last Filled: "_$GET(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,9,0))_" ("_STATUS_" at "_$GET(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,1,0))_") "
+14 WRITE !?10,"Rx Expiration Date: ",$GET(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,7,0)),?55,"Days Supply: "_$PIECE($PIECE($GET(^XTMP("ORRDI","PSOO",DFN,+ORDNUM,6,0)),";",2),"D",2)
+15 QUIT
+16 ;
NVADISP ;Display a Non-VA Medication Entry
+1 NEW GMTSPSTN,OALINE,ORIG,WLINE,DIWL,DIWR,DIWF,X
+2 KILL ^UTILITY($JOB,"W")
+3 DO CKP
if $DATA(GMTSQIT)
QUIT
+4 WRITE !,"Non-VA "_DRUGNM
DO CKP
if $DATA(GMTSQIT)
QUIT
+5 DO TEXT^ORQ12(.GMTSPSTN,ORDER,80)
+6 SET DIWL=IND1
SET DIWR=60
SET ORIG=2
+7 if $EXTRACT(GMTSPSTN(1),1,14)="Non-VA Change "
Begin DoDot:1
+8 FOR OALINE=2:1:$ORDER(GMTSPSTN(":"),-1)
IF $EXTRACT(GMTSPSTN(OALINE),1,3)="to "
SET ORIG=OALINE+1
QUIT
End DoDot:1
+9 FOR OALINE=ORIG:1:$ORDER(GMTSPSTN(":"),-1)
Begin DoDot:1
+10 SET X=$$LSIG($GET(GMTSPSTN(OALINE)))
+11 DO ^DIWP
End DoDot:1
+12 SET WLINE=0
FOR
SET WLINE=$ORDER(^UTILITY($JOB,"W",DIWL,WLINE))
if '+WLINE
QUIT
Begin DoDot:1
+13 WRITE !?DIWL,$GET(^UTILITY($JOB,"W",DIWL,WLINE,0))
+14 DO CKP
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+15 WRITE !
DO CKP
if $DATA(GMTSQIT)
QUIT
+16 QUIT
+1 DO CKP
if $DATA(GMTSQIT)
QUIT
WRITE !
+2 DO TEXTPRNT("FOOTER1")
+3 QUIT
+1 NEW LASTREL,FOOTTXT,DAYSSUPP,STATUS
+2 KILL ^TMP($JOB,"GMTSPSTN")
+3 SET PACKREF=$$PKGID^ORX8(ORDER)
+4 SET LASTREL=$$LRD(PACKREF)
+5 if LASTREL<$$FMADD^XLFDT(DT,-365)
QUIT
+6 if $PIECE(PSNUM,";")["N"
QUIT
+7 DO CKP
if $DATA(GMTSQIT)
QUIT
+8 WRITE !,"OPT "_DRUGNM
DO CKP
if $DATA(GMTSQIT)
QUIT
+9 DO RX^PSO52API(DFN,"GMTSPSTN",PACKREF)
+10 SET STATUS=$PIECE($GET(^TMP($JOB,"GMTSPSTN",DFN,PACKREF,100)),U,2)
+11 SET DAYSSUPP=$GET(^TMP($JOB,"GMTSPSTN",DFN,PACKREF,8))
+12 SET FOOTTXT="("_STATUS_"/"_DAYSSUPP_" Days Supply Last Released: "_$$FMTE^XLFDT(LASTREL,"2D")_")"
+13 WRITE $$RJ^XLFSTR(FOOTTXT,74)
DO CKP
if $DATA(GMTSQIT)
QUIT
+14 SET SIGLINE=0
FOR
SET SIGLINE=$ORDER(^TMP($JOB,"GMTSPSTN",DFN,PACKREF,"M",SIGLINE))
if '+SIGLINE
QUIT
Begin DoDot:1
+15 WRITE !?IND1,$GET(^TMP($JOB,"GMTSPSTN",DFN,PACKREF,"M",SIGLINE,0))
+16 DO CKP
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+17 DO CKP
+18 QUIT
NVADT() ;Replaces call previously in ^PSOQCF04
+1 NEW NVAL,NVARR
+2 DO ^PSOHCSUM
+3 if '$DATA(^TMP("PSOO",$JOB,"NVA"))
QUIT ""
+4 SET NVAL=0
FOR
SET NVAL=$ORDER(^TMP("PSOO",$JOB,"NVA",NVAL))
if '+NVAL
QUIT
Begin DoDot:1
+5 SET NVADT=9999999-$PIECE($GET(^TMP("PSOO",$JOB,"NVA",NVAL,0)),"^",5)
+6 SET NVARR(NVADT)=""
End DoDot:1
+7 SET NVADT=$ORDER(NVARR(0))
if NVADT=9999999
QUIT ""
+8 QUIT 9999999-NVADT
LSIG(SIG) ;Expand a SIG
+1 NEW P,SGY,X,%
+2 ;
SET SGY=""
FOR P=1:1:$LENGTH(SIG," ")
SET X=$PIECE(SIG," ",P)
if X]""
Begin DoDot:1
+3 IF $DATA(^PS(51,"A",X))
SET %=^(X)
SET X=$PIECE(%,"^")
IF $PIECE(%,"^",2)]""
SET Y=$PIECE(SIG," ",P-1)
SET Y=$EXTRACT(Y,$LENGTH(Y))
if Y>1
SET X=$PIECE(%,"^",2)
+4 SET SGY=SGY_X_" "
End DoDot:1
+5 QUIT SGY
LRD(PACKREF) ;Calculate LAST RELEASE DATE as latest of original + refill relDates
+1 NEW RELDT,REFDT,CTR,ANS
+2 KILL ^TMP($JOB,"GMTSLRD")
+3 SET ANS=""
+4 DO RX^PSO52API(DFN,"GMTSLRD",PACKREF,,"3,R")
+5 SET RELDT=$GET(^TMP($JOB,"GMTSLRD",DFN,PACKREF,31))
+6 SET ANS=RELDT
+7 ;
SET CTR=0
FOR
SET CTR=$ORDER(^TMP($JOB,"GMTSLRD",DFN,PACKREF,"RF",CTR))
if '+CTR
QUIT
Begin DoDot:1
+8 SET REFDT=$GET(^TMP($JOB,"GMTSLRD",DFN,PACKREF,"RF",CTR,17))
+9 IF REFDT>ANS
SET ANS=REFDT
End DoDot:1
+10 KILL ^TMP($JOB,"GMTSLRD")
+11 QUIT ANS
+12 ;
CKP DO CKP^GMTSUP
QUIT
+1 ;
GETPKG(ORDER) ;GET PACKAGE TYPE, added by GMTS*2.7*132
+1 NEW PKGIEN,PKGTYPE
+2 SET PKGIEN=$$GET1^DIQ(100,ORDER_",",12,"I")
+3 SET PKGTYPE=$$GET1^DIQ(9.4,PKGIEN_",",.01,"I")
+4 IF PKGTYPE="INPATIENT MEDICATIONS"
QUIT "I"
+5 IF PKGTYPE="OUTPATIENT PHARMACY"
QUIT "O"
+6 QUIT $$GET1^DIQ(100,ORDER_",",10,"I")
HEADTXT1 ;;
+1 ;;INCLUDED IN THIS LIST: Alphabetical list of active outpatient
+2 ;;prescriptions dispensed from this VA (local) and dispensed from another
+3 ;;VA or DoD facility (remote) as well as inpatient orders (local pending and
+4 ;;active), local clinic medications, locally documented non-VA medications,
+5 ;;and local prescriptions that have expired or been discontinued in the past
+6 ;;90 days.
+7 ;;
+8 ;;$$END
HEADTXT2 ;;
+1 ;;***NOTE*** The display of VA prescriptions dispensed from another VA or
+2 ;;DoD facility (remote) is limited to active outpatient prescription entries
+3 ;;matched to National Drug File at the originating site and may not include
+4 ;;some items such as investigational drugs, compounds, etc.
+5 ;;
+6 ;;NOT INCLUDED IN THIS LIST: Medications self-entered by the patient into
+7 ;;personal health records (i.e. My HealtheVet) are NOT included in this
+8 ;;list. Non-VA medications documented outside this VA, remote inpatient
+9 ;;orders (regardless of status) and remote clinic medications are NOT
+10 ;;included in this list. The patient and provider must always discuss
+11 ;;medications the patient is taking, regardless of where the medication was
+12 ;;dispensed or obtained.
+13 ;;$$END
