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

BVPRX.m

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