BVPRX ; IHS/ITSC/LJF - MEDICATION PROFILES ;
;;1.0;VIEW PATIENT RECORD;;NOV 17, 2004
; Called by BVP MED PROFILES (Medications) protocol
;
EN ;EP -- main entry point for list template BVP RX MENU
S VALMCC=1 ;1=screen mode, 0=scrolling mode
NEW VALMCNT D TERM^VALM0
S ORVP=DFN
D EN^VALM("BVP RX MENU")
D CLEAR^VALM1,EXIT
Q
;
HDR ;EP -- header code
Q
;
INIT ;EP -- init variables and list array
K ^TMP("BVPRX",$J)
N BVPX D ENP^XBDIQ1(9000001,DFN,".01;1101.2;1102.98","BVPX(")
S LINE=$$PAD($$SP(5)_"Patient: "_BVPX(.01),34)_" "_$$HRCN^BVPU(DFN)
S ^TMP("BVPRX",$J,1,0)=LINE
S LINE=$$PAD($$SP(9)_"Age: "_BVPX(1102.98),40)_"Sex: "_BVPX(1101.2)
S ^TMP("BVPRX",$J,2,0)=LINE
S LINE=$$SP(6)_"Status: "_$$STATUS^BVPU(DFN)
S ^TMP("BVPRX",$J,3,0)=LINE
S VALMCNT=3
Q
;
HELP ;EP -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ;EP -- exit code
K ^TMP("BVPRX",$J)
Q
;
EXPND ;EP -- expand code
Q
;
RESET ;EP -- update partition for return to list manager
I $D(VALMQUIT) S VALMBCK="Q" Q
S DFN=BVPSAV D SETPT^BVPMAIN(DFN) ;make sure patient is still set
D TERM^VALM0 S VALMBCK="R"
D INIT,HDR Q
;
RESET2 ;EP -- update partition without recreating display array
I $D(VALMQUIT) S VALMBCK="Q" Q
D TERM^VALM0 S VALMBCK="R" D HDR Q
;
MP ;EP; -- view medication profile
; Called by BVP RX MP (Med Profile: Outpatient) protocol
D FULL^VALM1
I '$D(^PS(55,DFN,"P")) D Q
. D MSG^BVPU("NO PHARMACY INFORMATION ON FILE",2,1,1)
. D PAUSE^BVPU
;
NEW PLS,PSRT,APSPDPT,APSPBD,APSPED,APSPAGE
K ^UTILITY($J) D FULL^VALM1
S APSPDPT(DFN)="",PSRT="DATE",APSPAGE=0,PLS="S"
S APSPBD=$$READ^BVPU("D^::EXP","Select Earliest Date","T-12M")
S APSPED=$$READ^BVPU("D^::EXP","Select Latest Date","TODAY")
S X="APSPMED" X ^%ZOSF("TEST") I $T U IO D P^APSPMED
D RSETPT
D PAUSE^BVPU
Q
;
IV ;EP -- calls IV profile
; Called by BVP RX IV (Med Profile: IV/Unit Dose) protocol
D FULL^VALM1
I '$D(^PS(55,DFN,"P")) D Q
. D MSG^BVPU("NO PHARMACY INFORMATION ON FILE",2,1,1)
. D PAUSE^BVPU
I $$VERSION^XPDUTL("PSJ")>4.5 D ENOR^PSJPR(DFN),RSETPT Q
S ORVP=DFN D ENOR^PSJPR,RSETPT
Q
;
PATINFO ;EP - drug info sheet for a patient
K PPL,PSOSD,PSODFN,PSORX,PSONUM
S PSODFN=+DFN,PSORX("NAME")=$$GET1^DIQ(2,DFN,.01)
S PSOQFLG=0 D ^PSOPTPST I PSOQFLG D PAUSE^BVPU Q ; Post patient selection routine
S PSONUM="LIST"
D EN^APSPNUM I '$D(PSOLIST) D PAUSE^BVPU Q
S PPL=PSOLIST(1)
D EN^APSEPPIM
D PAUSE^BVPU
Q
;
;
RSETPT ;EP -- resets patient variables
S DFN=BVPSAV,ORVP=DFN_";DPT(",DIC=9000001,DIC(0)="M",X="`"_DFN
D ^DIC Q
;
PAD(D,L) ; -- SUBRTN to pad length of data
; -- D=data L=length
Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
;
SP(N) ; -- SUBRTN to pad N number of spaces
Q $$PAD(" ",N)
;
BVPRX ; IHS/ITSC/LJF - MEDICATION PROFILES ;
+1 ;;1.0;VIEW PATIENT RECORD;;NOV 17, 2004
+2 ; Called by BVP MED PROFILES (Medications) protocol
+3 ;
EN ;EP -- main entry point for list template BVP RX MENU
+1 ;1=screen mode, 0=scrolling mode
SET VALMCC=1
+2 NEW VALMCNT
DO TERM^VALM0
+3 SET ORVP=DFN
+4 DO EN^VALM("BVP RX MENU")
+5 DO CLEAR^VALM1
DO EXIT
+6 QUIT
+7 ;
HDR ;EP -- header code
+1 QUIT
+2 ;
INIT ;EP -- init variables and list array
+1 KILL ^TMP("BVPRX",$JOB)
+2 NEW BVPX
DO ENP^XBDIQ1(9000001,DFN,".01;1101.2;1102.98","BVPX(")
+3 SET LINE=$$PAD($$SP(5)_"Patient: "_BVPX(.01),34)_" "_$$HRCN^BVPU(DFN)
+4 SET ^TMP("BVPRX",$JOB,1,0)=LINE
+5 SET LINE=$$PAD($$SP(9)_"Age: "_BVPX(1102.98),40)_"Sex: "_BVPX(1101.2)
+6 SET ^TMP("BVPRX",$JOB,2,0)=LINE
+7 SET LINE=$$SP(6)_"Status: "_$$STATUS^BVPU(DFN)
+8 SET ^TMP("BVPRX",$JOB,3,0)=LINE
+9 SET VALMCNT=3
+10 QUIT
+11 ;
HELP ;EP -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ;EP -- exit code
+1 KILL ^TMP("BVPRX",$JOB)
+2 QUIT
+3 ;
EXPND ;EP -- expand code
+1 QUIT
+2 ;
RESET ;EP -- update partition for return to list manager
+1 IF $DATA(VALMQUIT)
SET VALMBCK="Q"
QUIT
+2 ;make sure patient is still set
SET DFN=BVPSAV
DO SETPT^BVPMAIN(DFN)
+3 DO TERM^VALM0
SET VALMBCK="R"
+4 DO INIT
DO HDR
QUIT
+5 ;
RESET2 ;EP -- update partition without recreating display array
+1 IF $DATA(VALMQUIT)
SET VALMBCK="Q"
QUIT
+2 DO TERM^VALM0
SET VALMBCK="R"
DO HDR
QUIT
+3 ;
MP ;EP; -- view medication profile
+1 ; Called by BVP RX MP (Med Profile: Outpatient) protocol
+2 DO FULL^VALM1
+3 IF '$DATA(^PS(55,DFN,"P"))
Begin DoDot:1
+4 DO MSG^BVPU("NO PHARMACY INFORMATION ON FILE",2,1,1)
+5 DO PAUSE^BVPU
End DoDot:1
QUIT
+6 ;
+7 NEW PLS,PSRT,APSPDPT,APSPBD,APSPED,APSPAGE
+8 KILL ^UTILITY($JOB)
DO FULL^VALM1
+9 SET APSPDPT(DFN)=""
SET PSRT="DATE"
SET APSPAGE=0
SET PLS="S"
+10 SET APSPBD=$$READ^BVPU("D^::EXP","Select Earliest Date","T-12M")
+11 SET APSPED=$$READ^BVPU("D^::EXP","Select Latest Date","TODAY")
+12 SET X="APSPMED"
XECUTE ^%ZOSF("TEST")
IF $TEST
USE IO
DO P^APSPMED
+13 DO RSETPT
+14 DO PAUSE^BVPU
+15 QUIT
+16 ;
IV ;EP -- calls IV profile
+1 ; Called by BVP RX IV (Med Profile: IV/Unit Dose) protocol
+2 DO FULL^VALM1
+3 IF '$DATA(^PS(55,DFN,"P"))
Begin DoDot:1
+4 DO MSG^BVPU("NO PHARMACY INFORMATION ON FILE",2,1,1)
+5 DO PAUSE^BVPU
End DoDot:1
QUIT
+6 IF $$VERSION^XPDUTL("PSJ")>4.5
DO ENOR^PSJPR(DFN)
DO RSETPT
QUIT
+7 SET ORVP=DFN
DO ENOR^PSJPR
DO RSETPT
+8 QUIT
+9 ;
PATINFO ;EP - drug info sheet for a patient
+1 KILL PPL,PSOSD,PSODFN,PSORX,PSONUM
+2 SET PSODFN=+DFN
SET PSORX("NAME")=$$GET1^DIQ(2,DFN,.01)
+3 ; Post patient selection routine
SET PSOQFLG=0
DO ^PSOPTPST
IF PSOQFLG
DO PAUSE^BVPU
QUIT
+4 SET PSONUM="LIST"
+5 DO EN^APSPNUM
IF '$DATA(PSOLIST)
DO PAUSE^BVPU
QUIT
+6 SET PPL=PSOLIST(1)
+7 DO EN^APSEPPIM
+8 DO PAUSE^BVPU
+9 QUIT
+10 ;
+11 ;
RSETPT ;EP -- resets patient variables
+1 SET DFN=BVPSAV
SET ORVP=DFN_";DPT("
SET DIC=9000001
SET DIC(0)="M"
SET X="`"_DFN
+2 DO ^DIC
QUIT
+3 ;
PAD(D,L) ; -- SUBRTN to pad length of data
+1 ; -- D=data L=length
+2 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)
+3 ;
SP(N) ; -- SUBRTN to pad N number of spaces
+1 QUIT $$PAD(" ",N)
+2 ;
