Changeset 636 for FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOORFI2.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOORFI2.m (modified) (7 diffs)

FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOORFI2.m

@@ -1 @@
-PSOORFI2 ;BIR/BHW-finish cprs orders cont. ;07/29/96
- ;;7.0;OUTPATIENT PHARMACY;**7,15,23,27,46,130,146,177,222**;DEC 1997;Build 12
- ;External reference ^YSCL(603.01 supported by DBIA 2697
- ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
+PSOORFI2 ;BIR/BHW-finish cprs orders cont. ;1/27/07  13:25
+ ;;7.0;OUTPATIENT PHARMACY;**7,15,23,27,46,130,146,177,222,208**;DEC 1997;Build 39
+ ; Modified from FOIA VISTA,
+ ; GPL Copyright (C) 2007 WorldVistA
+ ;Ext ref ^YSCL(603.01 supported by DBIA 2697
+ ;Ext refs PSOL and PSOUL^PSSLOCK supported by DBIA 2789
 HLP W !,"Enter 'S' to process orders with a priority of STAT",!,"      'E' to process orders with an Emergency priority,",!,"      'R' to process Routine orders.",! Q
 HELP ;
@@ -20 +22 @@
  .I $P($G(^PS(52.41,PSZFZZ,0)),"^",3)="NW"!($P($G(^(0)),"^",3)="RNW")!($P($G(^(0)),"^",3)="RF") I $P($G(^PS(52.41,PSZFZZ,"INI")),"^")=$G(PSOPINST) S PSZFIN=0
  Q
-PROFILE ;display med profile
- S MEDA=3 ;3=question asked already
- W !!! K MEDP,DIR,DUOUT,DIRUT,DTOUT S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Do you want to see Medication Profile" D ^DIR K DIR Q:$D(DIRUT)!('Y)
- I Y S MEDP=1
+PROFILE ;
+ S MEDA=3
+ I $G(PSOAFYN)'="Y" W !!! K MEDP,DIR,DUOUT,DIRUT,DTOUT S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Do you want to see Medication Profile" D ^DIR K DIR Q:$D(DIRUT)!('Y)
+ I $G(PSOAFYN)'="Y" I Y S MEDP=1
+ I $G(PSOAFYN)="Y" K MEDP
  K DIR,DUOUT,DIRUT,DTOUT
  Q
 DC I '$G(PSOORRNW),$G(PSOOPT)=3 S PSORENW("DFLG")=1 S:'$D(PSOBBC1("FROM")) VALMBCK="Q",VALMSG="Renew Rx Request Canceled.",Y=-1 Q
- N VALMCNT W ! K DIR,DUOUT,DIROUT,DTOUT,PSOELSE I '$G(PSOERR("DEAD")) S PSOELSE=1 D  Q:$D(DIRUT)
+ I $G(PSOAFYN)'="Y" N VALMCNT W ! K DIR,DUOUT,DIROUT,DTOUT,PSOELSE I '$G(PSOERR("DEAD")) S PSOELSE=1 D  Q:$D(DIRUT)
  .D NOOR^PSOCAN4 Q:$D(DIRUT)
  .S DIR("A")="Comments",DIR(0)="F^10:75",DIR("B")="Per Pharmacy Request" D ^DIR K DIR
+ I $G(PSOAFYN)="Y" N VALMCNT K DIR,DUOUT,DIROUT,DTOUT,PSOELSE I '$G(PSOERR("DEAD")) S PSOELSE=1 D  Q:$D(DIRUT)  ;vfah
+ .D NOOR^PSOCAN4 Q:$D(DIRUT)  ;vfah
+ .S Y="Rx AutoFinish" ;vfah
+ I $G(PSOAFYN)'="Y" S PSOELSE="1"
  I '$G(PSOELSE) K PSOELSE S PSONOOR="A" G DE
  K PSOELSE I $D(DIRUT) K DIRUT,DUOUT,DTOUT,Y Q
  S ACOM=Y
-DE Q:'$D(^PS(52.41,ORD,0))
+DE I $G(PSOAFYN)="Y" Q
+ I $G(PSOAFYN)'="Y" Q:'$D(^PS(52.41,ORD,0))
  K ^PS(52.41,"AOR",$P(^PS(52.41,ORD,0),"^",2),+$P($G(^PS(52.41,ORD,"INI")),"^"),ORD),^PS(52.41,"AD",$P(^PS(52.41,ORD,0),"^",12),+$P($G(^PS(52.41,ORD,"INI")),"^"),ORD)
  S $P(^PS(52.41,ORD,0),"^",3)="DC",POERR("PLACER")=$P(^(0),"^"),POERR("STAT")="OC"
@@ -42 +50 @@
  S Y=-1 Q
  ;
-RF ;process refill request from CPRS
+RF ;
  S PSOREF("IRXN")=$P(OR0,"^",19) D PSOL^PSSLOCK($P(OR0,"^",19)) I '$G(PSOMSG) D  D PAUSE^VALM1 K PSOREF,PSOMSG Q
  .I $P($G(PSOMSG),"^",2)'="" W $C(7),!!,$P(PSOMSG,"^",2),! Q
@@ -52 +60 @@
  S PSONEW("DAYS SUPPLY")=$P(^PSRX(PSOREF("IRXN"),0),"^",8),PSONEW("# OF REFILLS")=$P(^(0),"^",9) D FULL^VALM1
  W !!,"Processing Refill Request for Rx "_$P(^PSRX(PSOREF("IRXN"),0),"^")
- ;S:$G(PSOREQFD)]"" PSORX("FILL DATE")=PSOREQFD
  D FILLDT^PSODIR2(.PSOREF) I PSOREF("DFLG") S VALMBCK="R" G END
- ;S:$G(PSORX("FILL DATE"))]"" PSOREQFD=PSORX("FILL DATE")
  ;
- ;S:$G(PSOREQMP)]"" PSORX(" METHOD OF PICK-UP")=PSOREQMP
  S PSORX("MAIL/WINDOW")=$S($P(OR0,"^",17)="M":"MAIL",1:"WINDOW") D MW^PSODIR2(.PSOREF) I PSOREF("DFLG") S VALMBCK="R" G END
- ;S:$G(PSORX("METHOD OF PICK-UP"))]"" PSOREQMP=PSORX("METHOD OF PICK-UP")
  S:'$G(PSOFROM)'="NEW" PSOFROM="REFILL" S PSOREF("DFLG")=0
  D ^PSOREF0
@@ -88 +92 @@
 KPRIZ K PSOQUIT,POERR("QFLG")
  Q
-INST ;Select Institution
+INST ;
  I '$G(PSOSITE) D ^PSOLSET I '$G(PSOSITE) S PSOIQUIT=1 Q
  N PSIR,PSCT,PSINST K PSOPINST
- S PSCT=0 F PSIR=0:0 S PSIR=$O(^PS(59,PSOSITE,"INI1",PSIR)) Q:'PSIR  I $P($G(^PS(59,PSOSITE,"INI1",PSIR,0)),"^") S PSCT=PSCT+1 I PSCT=1 S PSOPINST=$P($G(^(0)),"^")
+ I $G(PSOAFYN)="Y" S PSCT=1,PSOPINST=+ORL ;vfah selects CPRS Ordering Institution if autofinishing and non-interactive
+ I $G(PSOAFYN)'="Y" S PSCT=0 F PSIR=0:0 S PSIR=$O(^PS(59,PSOSITE,"INI1",PSIR)) Q:'PSIR  I $P($G(^PS(59,PSOSITE,"INI1",PSIR,0)),"^") S PSCT=PSCT+1 I PSCT=1 S PSOPINST=$P($G(^(0)),"^") ;vfah
  I PSCT=0 W !!,"There are no CPRS Ordering Institutions associated with this Outpatient site!",!,"Use the Site Parameter enter/edit option to enter CPRS Ordering Institutions!",! S PSOIQUIT=1 Q
  I PSCT=1 Q
@@ -104 +109 @@
  F PSIR=0:0 S PSIR=$O(^PS(59,PSOSITE,"INI1",PSIR)) Q:'PSIR!($G(PSOPINST))  I $P($G(^PS(59,PSOSITE,"INI1",PSIR,0)),"^") S PSOPINST=$P($G(^(0)),"^")
  Q
-CLOZ ;checks clozapine status of patient 
+CLOZ ;
  S CLOZPAT=$O(^YSCL(603.01,"C",PSODFN,0))
  S CLOZPAT=$P($G(^YSCL(603.01,+CLOZPAT,0)),"^",3)
@@ -113 +118 @@
  I $G(CLOZPAT)=2 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="   Patient Eligible for 28 Day Supply or 14 Day Supply with 1 refill or 7 Day Supply with 3 refill"
  Q
-USER(USER) ;returns .01 of 200
+USER(USER) ;
  K DIC,X,Y S DIC="^VA(200,",DIC(0)="M",X="`"_USER D ^DIC S USER1=$S(+Y:$P(Y,"^",2),1:"Unknown") K DIC,X,Y
  Q