Changeset 636 for FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOORFIN.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/PSOORFIN.m (modified) (5 diffs)

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

@@ -1 @@
-PSOORFIN ;BIR/SAB-finish cprs orders ;12/21/04 3:24pm
- ;;7.0;OUTPATIENT PHARMACY;**7,15,27,32,44,46,84,106,111,117,131,146,139,195**;DEC 1997
+PSOORFIN ;BIR/SAB-finish cprs orders ;5/14/07  09:47
+ ;;7.0;OUTPATIENT PHARMACY;**7,15,27,32,44,46,84,106,111,117,131,146,139,195,208**;DEC 1997;Build 39
+ ; Modified from FOIA VistA
+ ; Copyright (C) GNU GPL 2007 WorldVistA
+ ;
  ;PSSLOCK-2789,PSDRUG-221,50.7-2223,55-2228,50.606-2174
- D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) D MSG^PSODPT G EX
+ I $G(PSOAFYN)'="Y" D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) D MSG^PSODPT G EX ;vfah
+ I $G(PSOAFYN)="Y" D:'$D(PSOPAR) ^PSOAFSET I '$D(PSOPAR) D MSG^PSODPT G EX  ;vfah
  D INST^PSOORFI2 I $G(PSOIQUIT) K PSOIQUIT G EX
  I $P($G(PSOPAR),"^",2),'$D(^XUSEC("PSORPH",DUZ)) S PSORX("VERIFY")=1
- S (PSOFIN,POERR)=1 K PSOBCK,MEDA,MEDP,SRT,DIR D KQ S DIR("?")="^D ST^PSOORFI1",DIR("A")="Select By",DIR("B")="PATIENT",DIR(0)="SMB^PA:PATIENT;RT:ROUTE;PR:PRIORITY;CL:CLINIC;E:EXIT" D ^DIR I $D(DIRUT)!(Y="E") G EX
+ I $G(PSOAFYN)'="Y" S (PSOFIN,POERR)=1 K PSOBCK,MEDA,MEDP,SRT,DIR D KQ S DIR("?")="^D ST^PSOORFI1",DIR("A")="Select By",DIR("B")="PATIENT",DIR(0)="SMB^PA:PATIENT;RT:ROUTE;PR:PRIORITY;CL:CLINIC;E:EXIT" D ^DIR I $D(DIRUT)!(Y="E") G EX ;vfah
+ I $G(PSOAFYN)'="Y" S (PSOFIN,POERR)=1 K PSOBCK,MEDA,MEDP,SRT,DIR D KQ ;vfah
+ I $G(PSOAFYN)="Y" S Y="PA" ;vfah
  G:Y="PA" PAT G:Y="PR" PRI G:Y="CL" ^PSOORFI3
  K DIR S PSOSORT="ROUTE"
  S DIR("?")="^D RT^PSOORFI1",DIR("A")="Route",DIR(0)="SBM^W:WINDOW;M:MAIL;C:CLINIC;E:EXIT",DIR("B")="WINDOW"
  D ^DIR G:$D(DIRUT)!(Y="E") EX S PSOSORT=PSOSORT_"^"_Y,PSRT=Y
+ I $G(PSOAFYN)="Y" S PSOSORT="ROUTE^WINDOW",PSRT="WINDOW" ;vfah
  S LG=0,PATA=0 F  S LG=$O(^PS(52.41,"AD",LG)) Q:'LG!($G(POERR("QFLG")))  F PSOD=0:0 S PSOD=$O(^PS(52.41,"AD",LG,PSOPINST,PSOD)) Q:'PSOD!($G(POERR("QFLG")))  D
  .Q:$G(PAT($P(^PS(52.41,PSOD,0),"^",2)))=$P(^PS(52.41,PSOD,0),"^",2)  S PAT=$P(^PS(52.41,PSOD,0),"^",2)
@@ -44 +51 @@
  .D KQ F  S ORD=$O(^PS(52.41,"AC",PAT,"W",ORD)) Q:'ORD!($G(POERR("QFLG")))  D:$P(^PS(52.41,ORD,0),"^",3)'="DC"&($P(^(0),"^",3)'="DE") LK1,ORD
  Q
-PAT W ! K MEDP,MEDA,POERR("DFLG"),DIR D KQ S PSOSORT="PATIENT"
- S DIR("?")="^D PT^PSOORFI1",DIR("A")="All Patients or Single Patient",DIR(0)="SBM^A:ALL;S:SINGLE;E:EXIT",DIR("B")="SINGLE"
- D ^DIR K DIR G:$D(DIRUT)!(Y="E") EX I Y="S" S PSOSORT=PSOSORT_"^"_"SINGLE" G SPAT
+PAT I $G(PSOAFYN)'="Y" W ! K MEDP,MEDA,POERR("DFLG"),DIR D KQ S PSOSORT="PATIENT" ;vfah
+ I $G(PSOAFYN)="Y" K MEDP,MEDA,POERR("DFLG"),DIR D KQ S PSOSORT="PATIENT" ;vfah
+ I $G(PSOAFYN)'="Y" S DIR("?")="^D PT^PSOORFI1",DIR("A")="All Patients or Single Patient",DIR(0)="SBM^A:ALL;S:SINGLE;E:EXIT",DIR("B")="SINGLE" ;vfah
+ I $G(PSOAFYN)'="Y" D ^DIR K DIR G:$D(DIRUT)!(Y="E") EX I Y="S" S PSOSORT=PSOSORT_"^"_"SINGLE" G SPAT ;vfah
+ I $G(PSOAFYN)="Y" S PSOSORT=PSOSORT_"^"_"SINGLE" G SPAT ;vfah
  S PSOSORT=PSOSORT_"^ALL"
  S LG=0,PATA=0 F  S LG=$O(^PS(52.41,"AD",LG)) Q:'LG!($G(POERR("QFLG")))  F PSOD=0:0 S PSOD=$O(^PS(52.41,"AD",LG,PSOPINST,PSOD)) Q:'PSOD!($G(POERR("QFLG")))  D:$D(^PS(52.41,PSOD,0))
@@ -64 +73 @@
  G EX
 SPAT K MEDA,MEDP,PSOQFLG,PSORX("FN") D KQ,KV^PSOVER1
- S DIR(0)="FO^2:30",DIR("A")="Select Patient",DIR("?")="^D HELP^PSOORFI2" D ^DIR I $E(X)="?" G SPAT
- G:$D(DIRUT) EX D KV^PSOVER1
- S DIC(0)="EQM",DIC=2,DIC("S")="I $D(^PS(52.41,""AOR"",+Y,PSOPINST))"
- D ^DIC K DIC G:"^"[X EX G:Y=-1 SPAT S (PSODFN,PAT)=+Y,PSOFINY=Y
+ ;PSOAFIN begin SPAT
+ I $G(PSOAFDON)=1 G EX ;vfah
+ I $G(PSOAFYN)'="Y" S DIR(0)="FO^2:30",DIR("A")="Select Patient",DIR("?")="^D HELP^PSOORFI2" D ^DIR I $E(X)="?" G SPAT ;vfah
+ I $G(PSOAFYN)'="Y" G:$D(DIRUT) EX D KV^PSOVER1 ;vfah
+ I $G(PSOAFYN)'="Y" S DIC(0)="EQM",DIC=2,DIC("S")="I $D(^PS(52.41,""AOR"",+Y,PSOPINST))" ;vfah
+ I $G(PSOAFYN)'="Y" D ^DIC K DIC G:"^"[X EX G:Y=-1 SPAT S (PSODFN,PAT)=+Y,PSOFINY=Y ;vfah
+ ;PSOAFIN end SPAT
  D LK I $G(POERR("QFLG")) G SPAT
  N SNGLPAT S SNGLPAT=1
@@ -73 +85 @@
  D PP,SDFN,POST^PSOORFI1 D:$G(PSOQFLG)  G:$G(PSOQFLG) EX I $G(PSOQUIT) S:$G(PSOQUIT) POERR("QFLG")=1 S X=PAT D ULP G SPAT
  .S X=PAT D ULP
- S ORD=0 F  S ORD=$O(^PS(52.41,"P",PAT,ORD)) Q:'ORD!($G(POERR("QFLG")))  D
+ I PSOAFYN'="Y" S ORD=0 F  S ORD=$O(^PS(52.41,"P",PAT,ORD)) Q:'ORD!($G(POERR("QFLG")))  D  ;vhah
  .D:$P(^PS(52.41,ORD,0),"^",3)'="DC"&($P(^(0),"^",3)'="DE")&($P(^(0),"^",3)'="HD") LK1,ORD
+ I PSOAFYN="Y" S ORD=0,ORD=$O(^PS(52.41,"B",+ORDERID,ORD)) D:$P(^PS(52.41,ORD,0),"^",3)'="DC"&($P(^(0),"^",3)'="DE")&($P(^(0),"^",3)'="HD") LK1,ORD ;vfah
  I $O(PSORX("PSOL",0))!($D(RXRS)) D LBL
+ I $G(PSOAFYN)="Y" S PSOAFDON=1 ;vfah
  S PSOFIN=1,X=PAT D ULP G SPAT
 ORD I $G(PSOBCK) N LST,ORN
@@ -91 +105 @@
  .K PSOREEDT S (PSOORRNW,PSOFDR)=1,PSORENW("OIRXN")=$P(OR0,"^",21),PSOOPT=3,(PSORENW("DFLG"),PSORENW("QFLG"))=0 D ^PSOORRNW,SQR^PSOORFI3
  I $P(OR0,"^",3)="RF",$D(^PSRX(+$P(OR0,"^",19),0)) D RF^PSOORFI2 G SUCC
- N PSODRUG,PSONEW S PSOFROM="PENDING" D:'$G(PSOTPBFG) DSPL^PSOTPCAN(ORD) D DSPL^PSOORFI1,SQN^PSOORFI3
+ N PSODRUG,PSONEW S PSOFROM="PENDING" D:'$G(PSOTPBFG) DSPL^PSOTPCAN(ORD) D DSPL^PSOORFI1:'$D(ZTSK),SQN^PSOORFI3
 SUCC ;
- D UL1^PSOORFI3,FULL^VALM1
- D:$P($G(^PS(52.41,+$G(ORD),0)),"^",3)'="NW"&($P($G(^(0)),"^",3)'="RNW")&($P($G(^(0)),"^",3)'="HD")&($P($G(^(0)),"^",3)'="RF")
- .K PSOSD("PENDING",$S('$G(OID):$P(^PS(50.7,$P(OR0,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(OR0,"^",8),0),"^",2),0),"^"),1:$P(^PSDRUG($P(OR0,"^",9),0),"^")))
- S:$G(POERR("DFLG")) POERR("QFLG")=1 K POERR("DFLG"),PSONEW,ACP,OR0,DRET,SIG,OID,OI,PSORX("SC"),PSORX("CLINIC"),PSODRUG
+ D SUCC^PSOORFI5
  Q
-LBL S PSOFROM="NEW" D ^PSORXL K PSORX("PSOL"),PPL,RXRS
- D:$D(BINGCRT)&($D(BINGRTE)&($D(DISGROUP))) ^PSOBING1 K BINGCRT,BINGRTE,PSONEW,BBFLG,BBRX
+ ;
+LBL ;
+ D LBL^PSOORFI5
  Q
+ ;
 CHK ;
- D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W !,$C(7),"Outpatient Division MUST be selected!",! G EX
- D INST1^PSOORFI2
- S PSZCNT=0 F PSZZI=0:0 S PSZZI=$O(^PS(59,PSZZI)) Q:'PSZZI  S PSZCNT=PSZCNT+1
- S TC=0 F TO=0:0 S TO=$O(^PS(52.41,"AOR",TO)) Q:'TO  F TZ=0:0 S TZ=$O(^PS(52.41,"AOR",TO,TZ)) Q:'TZ  F PSTZ=0:0 S PSTZ=$O(^PS(52.41,"AOR",TO,TZ,PSTZ)) Q:'PSTZ  S TC=TC+1
- W !!?10,$C(7),"Orders to be completed"_$S(PSZCNT=1:": ",1:" for all divisions: ")_TC,! Q:'TC
- D SUMM^PSOORNE1 K PSZZI,PSZCNT,PSTZ
+ D CHK^PSOORFI5
  Q
+ ;
 PRI K DIR S PSOSORT="PRIORITY"
  S DIR("A")="Select Priority",DIR(0)="SBM^S:STAT;E:EMERGENCY;R:ROUTINE",DIR("B")="ROUTINE"