GMTSPST2 ;BIR/RMS - MED RECON TOOL #2 (MEDICATION WORKSHEET) ; Jul 03, 2024@09:54
;;2.7;Health Summary;**92,100,120,139**;Oct 20, 1995;Build 12
;
;Reference to COVER^ORWPS supported by DBIA 4926
;Reference to $$OI^ORX8 supported by DBIA 2467
;Reference to $$VALUE^ORCSAVE2 supported by DBIA 2747
;Reference to TEXT^ORQ12 supported by DBIA 4202
;References to ^ORCD supported by DBIA 5493
;
TOOL2 N DAYSEP,DRUGHDR1,DRUGHDR2,DRUGSEP,INSTSEP1,INSTSEP2
N EMPTYLN,PRETYPE,SUPTYPE,PSOQPEND
N BLNKLN,IDRUG,ISIG,ITYPE,PDRUG
N NVA,PAGE,PGWIDTH,PGLENGTH,GMTS59
N RXIEN,SIGCNT,SIGPOS,XPOS1,XPOS2,XPOS4
N RPTDATE,SUPCNT,SUPDRUG,VADM
S GMTS59=$$PSOSITE
S PGWIDTH=IOM-5,PGLENGTH=IOSL-9
Q:PGWIDTH<48 ;ensure that the IOM variable is wide enough
S RPTDATE=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
S XPOS1=(PGWIDTH-26)\2 ;title
S XPOS2=PGWIDTH-6 ;page number
S XPOS4=(PGWIDTH-53)\2 ;refill info
S $P(BLNKLN," ",PGWIDTH)=" "
S EMPTYLN="!,""|"_$E(BLNKLN,1,PGWIDTH-2)_"|"""
S DAYSEP="| | | | |"
S DRUGHDR1="| |MORNING| NOON |EVENING|BEDTIME| COMMENTS"
S DRUGHDR1=DRUGHDR1_$E(BLNKLN,$L(DRUGHDR1),PGWIDTH-2)_"|"
S DRUGHDR2="| "_DAYSEP
S DRUGHDR2=DRUGHDR2_$E(BLNKLN,$L(DRUGHDR2),PGWIDTH-2)_"|"
S $P(DRUGSEP,"~",PGWIDTH-2)="~"
S DRUGSEP="|"_DRUGSEP_"|"
S $P(INSTSEP1,"-",PGWIDTH-2)="-"
S INSTSEP1="|"_INSTSEP1_"|"
S INSTSEP2="| UNITS PER DOSE: "_DAYSEP
S INSTSEP2=INSTSEP2_$E(BLNKLN,$L(INSTSEP2),PGWIDTH-2)_"|"
S PAGE=1
D CKP^GMTSUP Q:$D(GMTSQIT)
D HD,SHOW(DFN)
Q
SHOW(DFN) ;
N LIST,NVA
D COVER^ORWPS(.LIST,DFN)
D GETOPORD(.LIST)
D GETRXDAT(.LIST)
S SUPTYPE=0,PRETYPE="D"
S ITYPE="@"
F S ITYPE=$O(LIST(ITYPE)) Q:ITYPE]"ZZZ" Q:ITYPE="" D
. I PRETYPE'=ITYPE D
. . W !,DRUGSEP
. . W @EMPTYLN
. . W !,"|","SUPPLY ITEMS:"_$E(BLNKLN,14,PGWIDTH-2)_"|"
. . S PRETYPE=ITYPE
. . I (ITYPE="S")&(SUPTYPE=0) D
. . . S SUPTYPE=1,SUPCNT=0,SUPDRUG=""
. . . F S SUPDRUG=$O(LIST(ITYPE,SUPDRUG)) Q:SUPDRUG="" D
. . . . S SUPCNT=SUPCNT+1
. . . I $Y>(PGLENGTH-SUPCNT) W !,DRUGSEP,@IOF D HD
. S IDRUG=""
. F S IDRUG=$O(LIST(ITYPE,IDRUG)) Q:IDRUG="" D
. . S SIGCNT=0,SIGPOS=""
. . F S SIGPOS=$O(LIST(ITYPE,IDRUG,SIGPOS)) Q:SIGPOS="" D
. . . S SIGCNT=SIGCNT+1
. . I $Y>(PGLENGTH-SIGCNT) W !,DRUGSEP,@IOF D HD
. . W:'SUPTYPE !,DRUGSEP,@EMPTYLN
. . S PDRUG=IDRUG I IDRUG?1"z**".E S PDRUG=$E(IDRUG,2,99)
. . W !,"|",PDRUG_$E(BLNKLN,$L(PDRUG),PGWIDTH-3)_"|"
. . Q:SUPTYPE
. . S ISIG=0
. . F S ISIG=$O(LIST(ITYPE,IDRUG,ISIG)) Q:ISIG<1 D
. . . W !,"| ",LIST(ITYPE,IDRUG,ISIG),$E(BLNKLN,$L(LIST(ITYPE,IDRUG,ISIG)),PGWIDTH-8),"|"
. . W !,INSTSEP1,!,INSTSEP2
NVA ;
I $D(NVA) D
. N NVACNT,NVADRUG
. W !,DRUGSEP
. W @EMPTYLN
. W !,"|","NON-VA Medications:"_$E(BLNKLN,20,PGWIDTH-2)_"|"
. W @EMPTYLN
. S NVACNT=0
. S NVADRUG=""
. F S NVADRUG=$O(NVA(NVADRUG)) Q:NVADRUG="" D
. . S NVACNT=NVACNT+1
. . I $Y>(PGLENGTH-NVACNT) W !,DRUGSEP,@IOF D HD
. . W !,"|",NVADRUG_$E(BLNKLN,$L(NVADRUG),PGWIDTH-3)_"|"
K NVACNT,NVADRUG
W !,INSTSEP1
D
. Q:'$G(PSOQPEND)
. W !!,"Any medication items listed as ""pending"" are those that have just been" D CKP^GMTSUP Q:$D(GMTSQIT)
. W !,"written by your provider(s). These medication orders will be reviewed" D CKP^GMTSUP Q:$D(GMTSQIT)
. W !,"by your pharmacist, prior to the prescription(s) being dispensed. When" D CKP^GMTSUP Q:$D(GMTSQIT)
. W !,"you receive your new prescription(s), by mail or from the pharmacy window," D CKP^GMTSUP Q:$D(GMTSQIT)
. W !,"be sure to follow the instructions on the prescription label. If you" D CKP^GMTSUP Q:$D(GMTSQIT)
. W !,"have any question about your medication, please call your provider or " D CKP^GMTSUP Q:$D(GMTSQIT)
. W !,"your pharmacist." D CKP^GMTSUP Q:$D(GMTSQIT)
. W !!,"Any medication items listed as ""NON-VA"" are Medications you do not get" D CKP^GMTSUP Q:$D(GMTSQIT)
. W !,"from a VA pharmacy that your provider recorded in your medical record." D CKP^GMTSUP Q:$D(GMTSQIT)
. W !,"This includes medication prescribed by VA or non VA providers, over the" D CKP^GMTSUP Q:$D(GMTSQIT)
. W !,"counter medications, herbals, samples or other medications you take." D CKP^GMTSUP Q:$D(GMTSQIT)
Q
GETOPORD(ORDLIST) ;
N LISTIEN,KILLORD
S LISTIEN=0
F S LISTIEN=$O(ORDLIST(LISTIEN)) Q:LISTIEN<1 D
. S KILLORD=$$IPORD(ORDLIST(LISTIEN))
. I 'KILLORD S KILLORD=$$CKSTATUS(ORDLIST(LISTIEN))
. K:KILLORD ORDLIST(LISTIEN)
Q
IPORD(LISTNODE) ;
N RETURN,PKG
S RETURN=0
S PKG=$P($P(LISTNODE,"^",1),";",2)
I "UI"[PKG S RETURN=1
;I $P(LISTNODE,"^",1)["N;" D
;. S:$P(LISTNODE,"^",4)="ACTIVE" NVA($P(LISTNODE,"^",2),+LISTNODE)=LISTNODE
;. S RETURN=1
Q RETURN
CKSTATUS(LISTNODE) ;
N RETURN,RXIEN
S RETURN=0 ; ASSUME ACTIVE AND NOT PASS MED
S:$P(LISTNODE,"^",4)["DISCONTINUED" RETURN=1
S:$P(LISTNODE,"^",4)["EXPIRED" RETURN=1
Q RETURN
GETRXDAT(RXS) ;
N RXSIEN,DRUGNAME,FSIG,RXTYPE
S RXSIEN=0
F S RXSIEN=$O(RXS(RXSIEN)) Q:RXSIEN<1 D
. I $P(RXS(RXSIEN),";")["P"!($P(RXS(RXSIEN),";")["N") D GETPEND(RXSIEN) S PSOQPEND=1 Q ;->
. S RXIEN=+RXS(RXSIEN)
. K FSIG
. S DRUGNAME=$$DRUGNAME(RXIEN)
. I $P(RXS(RXSIEN),U,4)="HOLD" S DRUGNAME=DRUGNAME_" (**Rx Status=HOLD**)"
. S RXTYPE=$$GETTYPE(RXIEN)
. N SIGLINE,DIWF,DIWL,X
. K ^UTILITY($J,"W")
. S DIWF="C"_(PGWIDTH-8),DIWL=1
. S SIGLINE=0 F S SIGLINE=$O(^TMP($J,"GMTSPSRX",DFN,RXIEN,"M",SIGLINE)) Q:'+SIGLINE D
.. S X=^TMP($J,"GMTSPSRX",DFN,RXIEN,"M",SIGLINE,0)
.. D ^DIWP
. S SIGLINE=0 F S SIGLINE=$O(^UTILITY($J,"W",1,SIGLINE)) Q:'+SIGLINE D
.. S FSIG(SIGLINE)=^UTILITY($J,"W",1,SIGLINE,0)
. M RXS(RXTYPE,DRUGNAME)=FSIG
. N PSOQSUB,REFILLS
. S PSOQSUB=$O(RXS(RXTYPE,DRUGNAME,":"),-1)+1
. S REFILLS=^TMP($J,"GMTSPSRX",DFN,RXIEN,9)-($S(^TMP($J,"GMTSPSRX",DFN,RXIEN,"RF",0)>0:^TMP($J,"GMTSPSRX",DFN,RXIEN,"RF",0),1:0))
. S RXS(RXTYPE,DRUGNAME,PSOQSUB)=REFILLS_" refill(s) remaining prior to "_$$FMTE^XLFDT(^TMP($J,"GMTSPSRX",DFN,RXIEN,26))_" (Rx #"_^TMP($J,"GMTSPSRX",DFN,RXIEN,.01)_")"
. K ^TMP($J,"GMTSPSRX"),^UTILITY($J,"W"),REFILLS
Q
DRUGNAME(RXIEN) ;
N DRUGIEN,DRUGNM,DRUGND1,DRUGND3,DRUGVAPN
D RX^PSO52API(DFN,"GMTSPSRX",RXIEN,,"0,2,3,R,M")
I ^TMP($J,"GMTSPSRX",DFN,RXIEN,6.5)]"" Q ^TMP($J,"GMTSPSRX",DFN,RXIEN,6.5)
S DRUGIEN=+^TMP($J,"GMTSPSRX",DFN,RXIEN,6)
S DRUGNM=$P(^TMP($J,"GMTSPSRX",DFN,RXIEN,6),U,2)
D NDF^PSS50(DRUGIEN,,,,,"GMTSNDF")
S DRUGND1=+^TMP($J,"GMTSNDF",DRUGIEN,20)
S DRUGND3=+^TMP($J,"GMTSNDF",DRUGIEN,22)
I DRUGND1,DRUGND3 S DRUGVAPN=$P($$PROD2^PSNAPIS(DRUGND1,DRUGND3),U)
K ^TMP($J,"GMTSNDF")
I $G(DRUGVAPN)]"" Q DRUGVAPN
Q DRUGNM
GETPEND(RXSIEN) ;
N PSOQPDN,PSOQDIND,PSOQ100,PSOQSCT,GMTSPST2,A,ORIFN
S PSOQ100=$P(RXS(RXSIEN),U,3) Q:'+PSOQ100
S PSOQPDN=$P($$OI^ORX8(PSOQ100),U,2)
S PSOQDIND=$$VALUE^ORCSAVE2(PSOQ100,"DRUG") D
. Q:'+PSOQDIND
. D DATA^PSS50(PSOQDIND,,,,,"GMTSPST2")
. S PSOQPDN=$G(^TMP($J,"GMTSPST2",PSOQDIND,.01))
D TEXT^ORQ12(.GMTSPST2,PSOQ100,65)
S A=$P(RXS(RXSIEN),";"),ORIFN=$P($P(RXS(RXSIEN),";",2),"^",3)
;I $E(A,$L(A))="N" D STATE
I A["P" F PSOQSCT=2:1:$O(GMTSPST2(":"),-1) S RXS("D","**PENDING** "_PSOQPDN,PSOQSCT)=GMTSPST2(PSOQSCT)
I A["N" D
. I '$D(GMTSPST2(2)) S RXS("D","z**NON-VA** "_PSOQPDN,1)=""
. F PSOQSCT=2:1:$O(GMTSPST2(":"),-1) S RXS("D","z**NON-VA** "_PSOQPDN,PSOQSCT)=GMTSPST2(PSOQSCT)
K ^TMP($J,"GMTSPST2")
Q
GETTYPE(RXIEN) ;
N RETURN,CLASS,DRUG
S RETURN="D"
S DRUG=+^TMP($J,"GMTSPSRX",DFN,RXIEN,6)
D DATA^PSS50(DRUG,,,,,"GMTSPS50")
S CLASS=^TMP($J,"GMTSPS50",DRUG,2)
K ^TMP($J,"GMTSPS50")
S:$E(CLASS,1,1)="X" RETURN="S"
S:$E(CLASS,1,2)="DX" RETURN="S"
Q RETURN
PSOSITE() ;DETERMINE APPROPRIATE 'OUTPATIENT SITE' (FILE #59) ENTRY
K ^TMP($J,"GMTSA59")
D PSS^PSO59(,"??","GMTSA59")
N GMTS59,STANUM
S GMTS59=0
I $G(DUZ(2))]"" D
. S STANUM=$$GET1^DIQ(4,DUZ(2),99)
. S GMTS59=$$GETDIV(STANUM,"ST")
I 'GMTS59 S GMTS59=$$GETDIV($$SITE^VASITE,"IN")
I 'GMTS59 S GMTS59=$O(^TMP($J,"GMTSA59",0))
Q GMTS59
GETDIV(STIN,TYPE) ;
I $G(STIN)']"" Q 0
N DIV,GETDIV
S (DIV,GETDIV)=0
F S DIV=$O(^TMP($J,"GMTSA59",DIV)) Q:'+DIV D
. I TYPE="ST",^TMP($J,"GMTSA59",DIV,.06)=STIN S GETDIV=DIV
. I TYPE="IN",^TMP($J,"GMTSA59",DIV,100)=STIN S GETDIV=DIV
Q GETDIV
HD ;
D 4^VADPT
D PSS^PSO59(GMTS59,,"GMTSSITE")
W !,"Date: ",RPTDATE,?XPOS1,"PATIENT MEDICATION INFORMATION"
W ?XPOS2,"Page: ",PAGE
S PAGE=PAGE+1
W !,?XPOS4,"PRINTED BY THE VA MEDICAL CENTER AT: "_$P(^TMP($J,"GMTSSITE",GMTS59,100),U,2)
W !,?XPOS4,"FOR PRESCRIPTION REFILLS CALL ("_^TMP($J,"GMTSSITE",GMTS59,.03)_") "_^TMP($J,"GMTSSITE",GMTS59,.04)
W !!,"Name: ",$E(VADM(1),1,28)
W ?30," PHARMACY - "_^TMP($J,"GMTSSITE",GMTS59,.01)_" DIVISION"
I ^TMP($J,"GMTSSITE",GMTS59,.01)'=^TMP($J,"GMTSSITE",GMTS59,.07) W " ("_^TMP($J,"GMTSSITE",GMTS59,.07)_")"
W !!,INSTSEP1,!,DRUGHDR1
D KVA^VADPT
K ^TMP($J,"GMTSSITE")
Q
STATE ;strip statments from SIG
N DLG,J,K,PTR,ORDIALOG,START
S DLG=$$PTR^ORCD("PSH OERR") D GETDLG^ORCD(DLG),GETORDER^ORCD(ORIFN)
S PTR=$P($G(ORDIALOG("B","SIG")),"^",2) Q:PTR=""
F PSOQSCT=2:1:$O(GMTSPST2(" "),-1) K GMTSPST2(PSOQSCT)
S J=0
F GMTSPST2=2:1 S J=$O(^TMP("ORWORD",$J,PTR,J)) Q:'J S K=0 F S K=$O(^TMP("ORWORD",$J,PTR,J,K)) Q:'K I $D(^TMP("ORWORD",$J,PTR,J,K,0)) S GMTSPST2(GMTSPST2)=^(0)
S PTR=$P($G(ORDIALOG("B","COMMENTS")),"^",2) Q:PTR=""
S J=0,GMTSPST2=GMTSPST2-1
F S J=$O(^TMP("ORWORD",$J,PTR,J)) Q:'J S K=0 F S K=$O(^TMP("ORWORD",$J,PTR,J,K)) Q:'K I $D(^TMP("ORWORD",$J,PTR,J,K,0)) S X=^(0) D ADD
Q
ADD ; -- Add text X to GMTSPST2()
N I,Y,Z S Y=$L(GMTSPST2(GMTSPST2)) S:Y Y=Y+1 ;allow for space
I $E(X)=" ",Y S GMTSPST2=GMTSPST2+1,GMTSPST2(GMTSPST2)="",Y=0,X=$E(X,2,999) ;new line
I Y+$L(X)'>65 S GMTSPST2(GMTSPST2)=GMTSPST2(GMTSPST2)_$S(Y:" ",1:"")_X Q
F I=1:1:$L(X," ") S Z=$P(X," ",I) D:(Y+$L(Z))>65 S GMTSPST2(GMTSPST2)=$G(GMTSPST2(GMTSPST2))_$S(Y:" ",1:"")_Z,Y=$L(GMTSPST2(GMTSPST2)) S:Y Y=Y+1
. I $L(Z)>65 F S GMTSPST2(GMTSPST2)=$G(GMTSPST2(GMTSPST2))_$S(Y:" ",1:"")_$E(Z,1,65-Y),Z=$E(Z,65-Y+1,999) Q:$L(Z)'>65 S GMTSPST2=GMTSPST2+1,Y=0
. S GMTSPST2=GMTSPST2+1,Y=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPST2 10205 printed Sep 23, 2025@19:35:45 Page 2
GMTSPST2 ;BIR/RMS - MED RECON TOOL #2 (MEDICATION WORKSHEET) ; Jul 03, 2024@09:54
+1 ;;2.7;Health Summary;**92,100,120,139**;Oct 20, 1995;Build 12
+2 ;
+3 ;Reference to COVER^ORWPS supported by DBIA 4926
+4 ;Reference to $$OI^ORX8 supported by DBIA 2467
+5 ;Reference to $$VALUE^ORCSAVE2 supported by DBIA 2747
+6 ;Reference to TEXT^ORQ12 supported by DBIA 4202
+7 ;References to ^ORCD supported by DBIA 5493
+8 ;
TOOL2 NEW DAYSEP,DRUGHDR1,DRUGHDR2,DRUGSEP,INSTSEP1,INSTSEP2
+1 NEW EMPTYLN,PRETYPE,SUPTYPE,PSOQPEND
+2 NEW BLNKLN,IDRUG,ISIG,ITYPE,PDRUG
+3 NEW NVA,PAGE,PGWIDTH,PGLENGTH,GMTS59
+4 NEW RXIEN,SIGCNT,SIGPOS,XPOS1,XPOS2,XPOS4
+5 NEW RPTDATE,SUPCNT,SUPDRUG,VADM
+6 SET GMTS59=$$PSOSITE
+7 SET PGWIDTH=IOM-5
SET PGLENGTH=IOSL-9
+8 ;ensure that the IOM variable is wide enough
if PGWIDTH<48
QUIT
+9 SET RPTDATE=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
+10 ;title
SET XPOS1=(PGWIDTH-26)\2
+11 ;page number
SET XPOS2=PGWIDTH-6
+12 ;refill info
SET XPOS4=(PGWIDTH-53)\2
+13 SET $PIECE(BLNKLN," ",PGWIDTH)=" "
+14 SET EMPTYLN="!,""|"_$EXTRACT(BLNKLN,1,PGWIDTH-2)_"|"""
+15 SET DAYSEP="| | | | |"
+16 SET DRUGHDR1="| |MORNING| NOON |EVENING|BEDTIME| COMMENTS"
+17 SET DRUGHDR1=DRUGHDR1_$EXTRACT(BLNKLN,$LENGTH(DRUGHDR1),PGWIDTH-2)_"|"
+18 SET DRUGHDR2="| "_DAYSEP
+19 SET DRUGHDR2=DRUGHDR2_$EXTRACT(BLNKLN,$LENGTH(DRUGHDR2),PGWIDTH-2)_"|"
+20 SET $PIECE(DRUGSEP,"~",PGWIDTH-2)="~"
+21 SET DRUGSEP="|"_DRUGSEP_"|"
+22 SET $PIECE(INSTSEP1,"-",PGWIDTH-2)="-"
+23 SET INSTSEP1="|"_INSTSEP1_"|"
+24 SET INSTSEP2="| UNITS PER DOSE: "_DAYSEP
+25 SET INSTSEP2=INSTSEP2_$EXTRACT(BLNKLN,$LENGTH(INSTSEP2),PGWIDTH-2)_"|"
+26 SET PAGE=1
+27 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+28 DO HD
DO SHOW(DFN)
+29 QUIT
SHOW(DFN) ;
+1 NEW LIST,NVA
+2 DO COVER^ORWPS(.LIST,DFN)
+3 DO GETOPORD(.LIST)
+4 DO GETRXDAT(.LIST)
+5 SET SUPTYPE=0
SET PRETYPE="D"
+6 SET ITYPE="@"
+7 FOR
SET ITYPE=$ORDER(LIST(ITYPE))
if ITYPE]"ZZZ"
QUIT
if ITYPE=""
QUIT
Begin DoDot:1
+8 IF PRETYPE'=ITYPE
Begin DoDot:2
+9 WRITE !,DRUGSEP
+10 WRITE @EMPTYLN
+11 WRITE !,"|","SUPPLY ITEMS:"_$EXTRACT(BLNKLN,14,PGWIDTH-2)_"|"
+12 SET PRETYPE=ITYPE
+13 IF (ITYPE="S")&(SUPTYPE=0)
Begin DoDot:3
+14 SET SUPTYPE=1
SET SUPCNT=0
SET SUPDRUG=""
+15 FOR
SET SUPDRUG=$ORDER(LIST(ITYPE,SUPDRUG))
if SUPDRUG=""
QUIT
Begin DoDot:4
+16 SET SUPCNT=SUPCNT+1
End DoDot:4
+17 IF $Y>(PGLENGTH-SUPCNT)
WRITE !,DRUGSEP,@IOF
DO HD
End DoDot:3
End DoDot:2
+18 SET IDRUG=""
+19 FOR
SET IDRUG=$ORDER(LIST(ITYPE,IDRUG))
if IDRUG=""
QUIT
Begin DoDot:2
+20 SET SIGCNT=0
SET SIGPOS=""
+21 FOR
SET SIGPOS=$ORDER(LIST(ITYPE,IDRUG,SIGPOS))
if SIGPOS=""
QUIT
Begin DoDot:3
+22 SET SIGCNT=SIGCNT+1
End DoDot:3
+23 IF $Y>(PGLENGTH-SIGCNT)
WRITE !,DRUGSEP,@IOF
DO HD
+24 if 'SUPTYPE
WRITE !,DRUGSEP,@EMPTYLN
+25 SET PDRUG=IDRUG
IF IDRUG?1"z**".E
SET PDRUG=$EXTRACT(IDRUG,2,99)
+26 WRITE !,"|",PDRUG_$EXTRACT(BLNKLN,$LENGTH(PDRUG),PGWIDTH-3)_"|"
+27 if SUPTYPE
QUIT
+28 SET ISIG=0
+29 FOR
SET ISIG=$ORDER(LIST(ITYPE,IDRUG,ISIG))
if ISIG<1
QUIT
Begin DoDot:3
+30 WRITE !,"| ",LIST(ITYPE,IDRUG,ISIG),$EXTRACT(BLNKLN,$LENGTH(LIST(ITYPE,IDRUG,ISIG)),PGWIDTH-8),"|"
End DoDot:3
+31 WRITE !,INSTSEP1,!,INSTSEP2
End DoDot:2
End DoDot:1
NVA ;
+1 IF $DATA(NVA)
Begin DoDot:1
+2 NEW NVACNT,NVADRUG
+3 WRITE !,DRUGSEP
+4 WRITE @EMPTYLN
+5 WRITE !,"|","NON-VA Medications:"_$EXTRACT(BLNKLN,20,PGWIDTH-2)_"|"
+6 WRITE @EMPTYLN
+7 SET NVACNT=0
+8 SET NVADRUG=""
+9 FOR
SET NVADRUG=$ORDER(NVA(NVADRUG))
if NVADRUG=""
QUIT
Begin DoDot:2
+10 SET NVACNT=NVACNT+1
+11 IF $Y>(PGLENGTH-NVACNT)
WRITE !,DRUGSEP,@IOF
DO HD
+12 WRITE !,"|",NVADRUG_$EXTRACT(BLNKLN,$LENGTH(NVADRUG),PGWIDTH-3)_"|"
End DoDot:2
End DoDot:1
+13 KILL NVACNT,NVADRUG
+14 WRITE !,INSTSEP1
+15 Begin DoDot:1
+16 if '$GET(PSOQPEND)
QUIT
+17 WRITE !!,"Any medication items listed as ""pending"" are those that have just been"
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+18 WRITE !,"written by your provider(s). These medication orders will be reviewed"
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+19 WRITE !,"by your pharmacist, prior to the prescription(s) being dispensed. When"
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+20 WRITE !,"you receive your new prescription(s), by mail or from the pharmacy window,"
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+21 WRITE !,"be sure to follow the instructions on the prescription label. If you"
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+22 WRITE !,"have any question about your medication, please call your provider or "
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+23 WRITE !,"your pharmacist."
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+24 WRITE !!,"Any medication items listed as ""NON-VA"" are Medications you do not get"
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+25 WRITE !,"from a VA pharmacy that your provider recorded in your medical record."
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+26 WRITE !,"This includes medication prescribed by VA or non VA providers, over the"
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+27 WRITE !,"counter medications, herbals, samples or other medications you take."
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
End DoDot:1
+28 QUIT
GETOPORD(ORDLIST) ;
+1 NEW LISTIEN,KILLORD
+2 SET LISTIEN=0
+3 FOR
SET LISTIEN=$ORDER(ORDLIST(LISTIEN))
if LISTIEN<1
QUIT
Begin DoDot:1
+4 SET KILLORD=$$IPORD(ORDLIST(LISTIEN))
+5 IF 'KILLORD
SET KILLORD=$$CKSTATUS(ORDLIST(LISTIEN))
+6 if KILLORD
KILL ORDLIST(LISTIEN)
End DoDot:1
+7 QUIT
IPORD(LISTNODE) ;
+1 NEW RETURN,PKG
+2 SET RETURN=0
+3 SET PKG=$PIECE($PIECE(LISTNODE,"^",1),";",2)
+4 IF "UI"[PKG
SET RETURN=1
+5 ;I $P(LISTNODE,"^",1)["N;" D
+6 ;. S:$P(LISTNODE,"^",4)="ACTIVE" NVA($P(LISTNODE,"^",2),+LISTNODE)=LISTNODE
+7 ;. S RETURN=1
+8 QUIT RETURN
CKSTATUS(LISTNODE) ;
+1 NEW RETURN,RXIEN
+2 ; ASSUME ACTIVE AND NOT PASS MED
SET RETURN=0
+3 if $PIECE(LISTNODE,"^",4)["DISCONTINUED"
SET RETURN=1
+4 if $PIECE(LISTNODE,"^",4)["EXPIRED"
SET RETURN=1
+5 QUIT RETURN
GETRXDAT(RXS) ;
+1 NEW RXSIEN,DRUGNAME,FSIG,RXTYPE
+2 SET RXSIEN=0
+3 FOR
SET RXSIEN=$ORDER(RXS(RXSIEN))
if RXSIEN<1
QUIT
Begin DoDot:1
+4 ;->
IF $PIECE(RXS(RXSIEN),";")["P"!($PIECE(RXS(RXSIEN),";")["N")
DO GETPEND(RXSIEN)
SET PSOQPEND=1
QUIT
+5 SET RXIEN=+RXS(RXSIEN)
+6 KILL FSIG
+7 SET DRUGNAME=$$DRUGNAME(RXIEN)
+8 IF $PIECE(RXS(RXSIEN),U,4)="HOLD"
SET DRUGNAME=DRUGNAME_" (**Rx Status=HOLD**)"
+9 SET RXTYPE=$$GETTYPE(RXIEN)
+10 NEW SIGLINE,DIWF,DIWL,X
+11 KILL ^UTILITY($JOB,"W")
+12 SET DIWF="C"_(PGWIDTH-8)
SET DIWL=1
+13 SET SIGLINE=0
FOR
SET SIGLINE=$ORDER(^TMP($JOB,"GMTSPSRX",DFN,RXIEN,"M",SIGLINE))
if '+SIGLINE
QUIT
Begin DoDot:2
+14 SET X=^TMP($JOB,"GMTSPSRX",DFN,RXIEN,"M",SIGLINE,0)
+15 DO ^DIWP
End DoDot:2
+16 SET SIGLINE=0
FOR
SET SIGLINE=$ORDER(^UTILITY($JOB,"W",1,SIGLINE))
if '+SIGLINE
QUIT
Begin DoDot:2
+17 SET FSIG(SIGLINE)=^UTILITY($JOB,"W",1,SIGLINE,0)
End DoDot:2
+18 MERGE RXS(RXTYPE,DRUGNAME)=FSIG
+19 NEW PSOQSUB,REFILLS
+20 SET PSOQSUB=$ORDER(RXS(RXTYPE,DRUGNAME,":"),-1)+1
+21 SET REFILLS=^TMP($JOB,"GMTSPSRX",DFN,RXIEN,9)-($SELECT(^TMP($JOB,"GMTSPSRX",DFN,RXIEN,"RF",0)>0:^TMP($JOB,"GMTSPSRX",DFN,RXIEN,"RF",0),1:0))
+22 SET RXS(RXTYPE,DRUGNAME,PSOQSUB)=REFILLS_" refill(s) remaining prior to "_$$FMTE^XLFDT(^TMP($JOB,"GMTSPSRX",DFN,RXIEN,26))_" (Rx #"_^TMP($JOB,"GMTSPSRX",DFN,RXIEN,.01)_")"
+23 KILL ^TMP($JOB,"GMTSPSRX"),^UTILITY($JOB,"W"),REFILLS
End DoDot:1
+24 QUIT
DRUGNAME(RXIEN) ;
+1 NEW DRUGIEN,DRUGNM,DRUGND1,DRUGND3,DRUGVAPN
+2 DO RX^PSO52API(DFN,"GMTSPSRX",RXIEN,,"0,2,3,R,M")
+3 IF ^TMP($JOB,"GMTSPSRX",DFN,RXIEN,6.5)]""
QUIT ^TMP($JOB,"GMTSPSRX",DFN,RXIEN,6.5)
+4 SET DRUGIEN=+^TMP($JOB,"GMTSPSRX",DFN,RXIEN,6)
+5 SET DRUGNM=$PIECE(^TMP($JOB,"GMTSPSRX",DFN,RXIEN,6),U,2)
+6 DO NDF^PSS50(DRUGIEN,,,,,"GMTSNDF")
+7 SET DRUGND1=+^TMP($JOB,"GMTSNDF",DRUGIEN,20)
+8 SET DRUGND3=+^TMP($JOB,"GMTSNDF",DRUGIEN,22)
+9 IF DRUGND1
IF DRUGND3
SET DRUGVAPN=$PIECE($$PROD2^PSNAPIS(DRUGND1,DRUGND3),U)
+10 KILL ^TMP($JOB,"GMTSNDF")
+11 IF $GET(DRUGVAPN)]""
QUIT DRUGVAPN
+12 QUIT DRUGNM
GETPEND(RXSIEN) ;
+1 NEW PSOQPDN,PSOQDIND,PSOQ100,PSOQSCT,GMTSPST2,A,ORIFN
+2 SET PSOQ100=$PIECE(RXS(RXSIEN),U,3)
if '+PSOQ100
QUIT
+3 SET PSOQPDN=$PIECE($$OI^ORX8(PSOQ100),U,2)
+4 SET PSOQDIND=$$VALUE^ORCSAVE2(PSOQ100,"DRUG")
Begin DoDot:1
+5 if '+PSOQDIND
QUIT
+6 DO DATA^PSS50(PSOQDIND,,,,,"GMTSPST2")
+7 SET PSOQPDN=$GET(^TMP($JOB,"GMTSPST2",PSOQDIND,.01))
End DoDot:1
+8 DO TEXT^ORQ12(.GMTSPST2,PSOQ100,65)
+9 SET A=$PIECE(RXS(RXSIEN),";")
SET ORIFN=$PIECE($PIECE(RXS(RXSIEN),";",2),"^",3)
+10 ;I $E(A,$L(A))="N" D STATE
+11 IF A["P"
FOR PSOQSCT=2:1:$ORDER(GMTSPST2(":"),-1)
SET RXS("D","**PENDING** "_PSOQPDN,PSOQSCT)=GMTSPST2(PSOQSCT)
+12 IF A["N"
Begin DoDot:1
+13 IF '$DATA(GMTSPST2(2))
SET RXS("D","z**NON-VA** "_PSOQPDN,1)=""
+14 FOR PSOQSCT=2:1:$ORDER(GMTSPST2(":"),-1)
SET RXS("D","z**NON-VA** "_PSOQPDN,PSOQSCT)=GMTSPST2(PSOQSCT)
End DoDot:1
+15 KILL ^TMP($JOB,"GMTSPST2")
+16 QUIT
GETTYPE(RXIEN) ;
+1 NEW RETURN,CLASS,DRUG
+2 SET RETURN="D"
+3 SET DRUG=+^TMP($JOB,"GMTSPSRX",DFN,RXIEN,6)
+4 DO DATA^PSS50(DRUG,,,,,"GMTSPS50")
+5 SET CLASS=^TMP($JOB,"GMTSPS50",DRUG,2)
+6 KILL ^TMP($JOB,"GMTSPS50")
+7 if $EXTRACT(CLASS,1,1)="X"
SET RETURN="S"
+8 if $EXTRACT(CLASS,1,2)="DX"
SET RETURN="S"
+9 QUIT RETURN
PSOSITE() ;DETERMINE APPROPRIATE 'OUTPATIENT SITE' (FILE #59) ENTRY
+1 KILL ^TMP($JOB,"GMTSA59")
+2 DO PSS^PSO59(,"??","GMTSA59")
+3 NEW GMTS59,STANUM
+4 SET GMTS59=0
+5 IF $GET(DUZ(2))]""
Begin DoDot:1
+6 SET STANUM=$$GET1^DIQ(4,DUZ(2),99)
+7 SET GMTS59=$$GETDIV(STANUM,"ST")
End DoDot:1
+8 IF 'GMTS59
SET GMTS59=$$GETDIV($$SITE^VASITE,"IN")
+9 IF 'GMTS59
SET GMTS59=$ORDER(^TMP($JOB,"GMTSA59",0))
+10 QUIT GMTS59
GETDIV(STIN,TYPE) ;
+1 IF $GET(STIN)']""
QUIT 0
+2 NEW DIV,GETDIV
+3 SET (DIV,GETDIV)=0
+4 FOR
SET DIV=$ORDER(^TMP($JOB,"GMTSA59",DIV))
if '+DIV
QUIT
Begin DoDot:1
+5 IF TYPE="ST"
IF ^TMP($JOB,"GMTSA59",DIV,.06)=STIN
SET GETDIV=DIV
+6 IF TYPE="IN"
IF ^TMP($JOB,"GMTSA59",DIV,100)=STIN
SET GETDIV=DIV
End DoDot:1
+7 QUIT GETDIV
HD ;
+1 DO 4^VADPT
+2 DO PSS^PSO59(GMTS59,,"GMTSSITE")
+3 WRITE !,"Date: ",RPTDATE,?XPOS1,"PATIENT MEDICATION INFORMATION"
+4 WRITE ?XPOS2,"Page: ",PAGE
+5 SET PAGE=PAGE+1
+6 WRITE !,?XPOS4,"PRINTED BY THE VA MEDICAL CENTER AT: "_$PIECE(^TMP($JOB,"GMTSSITE",GMTS59,100),U,2)
+7 WRITE !,?XPOS4,"FOR PRESCRIPTION REFILLS CALL ("_^TMP($JOB,"GMTSSITE",GMTS59,.03)_") "_^TMP($JOB,"GMTSSITE",GMTS59,.04)
+8 WRITE !!,"Name: ",$EXTRACT(VADM(1),1,28)
+9 WRITE ?30," PHARMACY - "_^TMP($JOB,"GMTSSITE",GMTS59,.01)_" DIVISION"
+10 IF ^TMP($JOB,"GMTSSITE",GMTS59,.01)'=^TMP($JOB,"GMTSSITE",GMTS59,.07)
WRITE " ("_^TMP($JOB,"GMTSSITE",GMTS59,.07)_")"
+11 WRITE !!,INSTSEP1,!,DRUGHDR1
+12 DO KVA^VADPT
+13 KILL ^TMP($JOB,"GMTSSITE")
+14 QUIT
STATE ;strip statments from SIG
+1 NEW DLG,J,K,PTR,ORDIALOG,START
+2 SET DLG=$$PTR^ORCD("PSH OERR")
DO GETDLG^ORCD(DLG)
DO GETORDER^ORCD(ORIFN)
+3 SET PTR=$PIECE($GET(ORDIALOG("B","SIG")),"^",2)
if PTR=""
QUIT
+4 FOR PSOQSCT=2:1:$ORDER(GMTSPST2(" "),-1)
KILL GMTSPST2(PSOQSCT)
+5 SET J=0
+6 FOR GMTSPST2=2:1
SET J=$ORDER(^TMP("ORWORD",$JOB,PTR,J))
if 'J
QUIT
SET K=0
FOR
SET K=$ORDER(^TMP("ORWORD",$JOB,PTR,J,K))
if 'K
QUIT
IF $DATA(^TMP("ORWORD",$JOB,PTR,J,K,0))
SET GMTSPST2(GMTSPST2)=^(0)
+7 SET PTR=$PIECE($GET(ORDIALOG("B","COMMENTS")),"^",2)
if PTR=""
QUIT
+8 SET J=0
SET GMTSPST2=GMTSPST2-1
+9 FOR
SET J=$ORDER(^TMP("ORWORD",$JOB,PTR,J))
if 'J
QUIT
SET K=0
FOR
SET K=$ORDER(^TMP("ORWORD",$JOB,PTR,J,K))
if 'K
QUIT
IF $DATA(^TMP("ORWORD",$JOB,PTR,J,K,0))
SET X=^(0)
DO ADD
+10 QUIT
ADD ; -- Add text X to GMTSPST2()
+1 ;allow for space
NEW I,Y,Z
SET Y=$LENGTH(GMTSPST2(GMTSPST2))
if Y
SET Y=Y+1
+2 ;new line
IF $EXTRACT(X)=" "
IF Y
SET GMTSPST2=GMTSPST2+1
SET GMTSPST2(GMTSPST2)=""
SET Y=0
SET X=$EXTRACT(X,2,999)
+3 IF Y+$LENGTH(X)'>65
SET GMTSPST2(GMTSPST2)=GMTSPST2(GMTSPST2)_$SELECT(Y:" ",1:"")_X
QUIT
+4 FOR I=1:1:$LENGTH(X," ")
SET Z=$PIECE(X," ",I)
if (Y+$LENGTH(Z))>65
Begin DoDot:1
+5 IF $LENGTH(Z)>65
FOR
SET GMTSPST2(GMTSPST2)=$GET(GMTSPST2(GMTSPST2))_$SELECT(Y:" ",1:"")_$EXTRACT(Z,1,65-Y)
SET Z=$EXTRACT(Z,65-Y+1,999)
if $LENGTH(Z)'>65
QUIT
SET GMTSPST2=GMTSPST2+1
SET Y=0
+6 SET GMTSPST2=GMTSPST2+1
SET Y=0
End DoDot:1
SET GMTSPST2(GMTSPST2)=$GET(GMTSPST2(GMTSPST2))_$SELECT(Y:" ",1:"")_Z
SET Y=$LENGTH(GMTSPST2(GMTSPST2))
if Y
SET Y=Y+1
+7 QUIT
