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

PSOSD2.m

Go to the documentation of this file.
  1. PSOSD2 ;BHAM ISC/SAB - action or informational profile cont. ;3/24/93
  1. ;;7.0;OUTPATIENT PHARMACY;**2,19,107,110,176,233,258,326,500**;DEC 1997;Build 9
  1. ;External reference to ^PS(59.7 is supported by DBIA 694
  1. ;
  1. 1 W !,$E(LINE,1,$S('PSORM:80,1:IOM)-1),!
  1. W !,"Instructions to the provider:"
  1. W !," A. A prescription blank (VA FORM 10-2577f) must be used for the"
  1. W !," following: 1) any new medication"
  1. W !," 2) any changes in dosage, direction or quantity"
  1. W !," 3) all class II narcotics."
  1. W !," B. To continue a medication as printed:"
  1. W !," 1. If ""Remaining Refills"" are sufficient to complete"
  1. W !," therapy or last until next scheduled clinic appointment,"
  1. W !," no action is required."
  1. W !," 2. If ""Remaining Refills"" are not sufficient to complete"
  1. W !," therapy or last until next scheduled clinic appointment,"
  1. W !," sign ""RENEW/MD"" line, enter VA# and date, and circle"
  1. W !," total number of refills needed. This action creates a"
  1. W !," new prescription with refills as indicated."
  1. W !," C. To discontinue a medication, sign DISCONTINUE/MD line and enter VA# and",@$S(PSORM:"?$X+1",1:"!?6"),"date."
  1. W !," D. Any medications not acted upon will continue to be available"
  1. W !," to the patient until all refills are used or until expiration."
  1. W !!," NOTE: '(R)' indicates a fill was returned to stock."
  1. Q
  1. ;
  1. HD S:'$D(PSORM) PSORM=1 N K S FN=DFN
  1. D ELIG^PSOSD1,DEM^VADPT,INP^VADPT,ADD^VADPT,PID^VADPT S PSSN=VA("PID"),ADDRFL=$S(+VAPA(9):"Temporary ",1:"")
  1. I $G(^TMP($J,DFN)),$D(CLINICX) D ^PSOSDP
  1. S PSNAME=$E(VADM(1),1,28),PSDOB=$P(VADM(3),"^",2)
  1. I '$D(PSOBAR0)!('$D(PSOBAR1)) S PSOIOS=IOS D DEVBAR^PSOBMST
  1. S PSOBAR2=PSOBAR0,PSOBAR3=PSOBAR1
  1. S PSOBAR4=$G(PSOBAR3)]""&($G(PSOBAR2)]"")&(+$P($G(PSOPAR),"^"))
  1. HD1 S RXCNT=0 I $E(IOST)="C",'PSTYPE K DIR S DIR(0)="E",DIR("A")="Press Return to Continue or ""^"" to Exit" D ^DIR Q:$D(DTOUT)!($D(DUOUT))
  1. I $D(IOF) W @IOF
  1. U IO
  1. W $S(PSTYPE:"Action",1:"Informational")_" Rx Profile",?47,"Run Date: " S Y=DT D DT^DIO2 W ?71,"Page: "_PAGE
  1. W !,"Sorted by drug classification for Rx's currently active"_$S('PSDAYS:" only.",1:"") W:PSDAYS !,"and for those Rx's that have been inactive less than "_PSDAYS_" days."
  1. S X=$$SITE^VASITE
  1. W @$S(PSORM:"?70",1:"!"),"Site: VAMC "_$P(X,"^",2)_" ("_$P(X,"^",3)_")",!,$E(LINE,1,$S('PSORM:80,1:IOM)-1)
  1. I $P(VAIN(4),"^",2)]"",+$P($G(^PS(59.7,1,40.1)),"^") W !,"Outpatient prescriptions are discontinued 72 hours after admission.",!
  1. I $D(CLINICX) W !?1,"Clinic: ",$E(CLINICX,1,28),?45,"Date/Time: " S Y=CLDT D DT^DIO2
  1. W !?1,"Name : ",PSNAME W:PSTYPE ?58,"Action Date: ________" W !?1,"DOB : "_PSDOB
  1. W:ADDRFL]"" ?30,ADDRFL,! W ?30,"Address :"
  1. I $G(ADDRFL)="" D CHECKBAI^PSOSD1
  1. W ?41,VAPA(1) W:VAPA(2)]"" !?41,VAPA(2) W:VAPA(3)]"" !?41,VAPA(3)
  1. W !?41,VAPA(4)_", "_$P(VAPA(5),"^",2)_" "_$S(VAPA(11)]"":$P(VAPA(11),"^",2),1:VAPA(6)),!?30,"Phone : "_VAPA(8)
  1. I PSOBAR4 S X="S",X2=PSSN W @$S('PSORM:"!?30",1:"?$X+5") S X1=$X W @PSOBAR3,X2,@PSOBAR2,$C(13) S $X=0
  1. W:$G(DOD(DFN))]"" ?1,"**** Date of Death: "_DOD(DFN)_" ****",!
  1. D:'$D(HDFL)
  1. .K DIRUT,DIR,DUOUT,DTOUT D:'$G(CLAPP) RE^PSODEM Q:$D(DIRUT)
  1. .I $Y+15>IOSL,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR K DIR,DUOUT,DTOUT
  1. .Q:$D(DIRUT)
  1. .K ^UTILITY("VASD",$J),VASD S VASD("F")=DT,VASD("T")=9999999,VASD("W")="123456789" D:$G(DFN)&('$G(CLAPP)) SDA^VADPT K VASD I '$G(CLAPP)&($D(^UTILITY("VASD",$J))) D S CLAPP=1 D HD:$G(^TMP($J,DFN))'<$G(PSONUM)&($G(PSOPOL))
  1. ..W:$E(IOST)="C" @IOF
  1. ..W !,$E(LINE,1,$S('PSORM:80,1:IOM)-1)
  1. ..S FA=DT W !!,"Pending Outpatient Clinic Appointments:"
  1. ..F PSOACPP=0:0 S PSOACPP=$O(^UTILITY("VASD",$J,PSOACPP)) Q:'PSOACPP S PSOACPPE=$G(^UTILITY("VASD",$J,PSOACPP,"E")),PSOACPPI=$G(^("I")) W !?11,$P(PSOACPPE,"^"),?35,$P(PSOACPPE,"^",2) D CAPP
  1. ..I $E(IOST)="C" K DIR,DIRUT,DTOUT S DIR(0)="E" D ^DIR K DIR
  1. .E D:$G(PAGE)>1&('$G(PSOPOL))
  1. ..S (WT,HT)="",X="GMRVUTL" X ^%ZOSF("TEST") I $T D
  1. ...F GMRVSTR="WT","HT" S VM=GMRVSTR D EN6^GMRVUTL S @VM=X,$P(@VM,"^")=$E($P(@VM,"^"),4,5)_"/"_$E($P(@VM,"^"),6,7)_"/"_($E($P(@VM,"^"),1,3)+1700)
  1. ...S X=$P(WT,"^",8),Y=$J(X/2.2046226,0,2),$P(WT,"^",9)=Y,X=$P(HT,"^",8),Y=$J(2.54*X,0,2),$P(HT,"^",9)=Y
  1. ..W !!,"WEIGHT(Kg): " W:+$P(WT,"^",8) $P(WT,"^",9)_" ("_$P(WT,"^")_")" W ?41,"HEIGHT(cm): " W:$P(HT,"^",8) $P(HT,"^",9)_" ("_$P(HT,"^")_")" K VM,WT,HT
  1. D:$D(DIRUT) KLCL Q:$D(DIRUT) S PAGE=PAGE+1 I $D(^UTILITY("VASD",$J)),PAGE=2!($G(PSOPOLP)) D KLCL S PSOPOLP=0 D HD Q
  1. D KLCL I PSTYPE,'$D(HDFL) D 1 S HDFL=""
  1. W !,$E(LINE,1,$S('PSORM:80,1:IOM)-1),!,"Medication/Supply" Q:'PSORM
  1. W ?74,"Rx#",?85,"Status",?98,"Expiration",?110,"Provider",!,?101,"Date"
  1. Q
  1. ;
  1. CAPP ;
  1. K X S X2=DT,X1=$P($P($G(PSOACPPI),"^"),".") I $G(X1) D ^%DTC
  1. W $S($P(PSOACPPI,"^",3)["C":" *** Canceled ***",1:" ("_$G(X)_" days)")
  1. Q
  1. PSRENW D:'$G(PSODTCUT) CUTDATE^PSOFUNC I $P(RX2,"^",6)<PSODTCUT S PSRENW=0 G LN
  1. I $E($P(RX0,"^",15))="D",$P(RX3,"^",5)<PSODTCUT,$P(^PSRX(RXNO,"STA"),"^")=12 S PSRENW=0 G LN
  1. I $E($P(RX0,"^",15))="D",$P(^PSRX(RXNO,"STA"),"^")'=12 S PSRENW=0
  1. LN S CS=0 F DEA=1:1 Q:$E(PSODEA,DEA)="" I $E(+PSODEA,DEA)>2,$E(+PSODEA,DEA)<6 S CS=1
  1. K DEA,PSODEA Q
  1. KLCL K ^UTILITY("VASD",$J),PSOACPPI,PSOACPPE,PSOACPP Q