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

PSOREF1.m

Go to the documentation of this file. 
  1. PSOREF1 ;IHS/DSD/JCM-ASKS ALL QUESTIONS FOR REFILL RX ORDER ENTRY;21-Apr-2005 14:19;SM
  1.  ;;7.0;OUTPATIENT PHARMACY;**26,1001,1003**;DEC 1997
  1.  ;External reference ^PSDRUG( supported by DBIA 221
  1.  ; Modified - IHS/CIA/PLS - 01/06/04 - Line 2 and added several fields
  1.  ;                          10/27/04 - Move previous mod to separate EP.
  1. START ;
  1.  S (PSOREF("DFLG"),PSOREF("FIELD"),PSOREF1)=0
  1.  S X="T-6M",%DT="X" D ^%DT
  1.  S (PSOID,PSOREF("ISSUE DATE"))=$S($P(^PSRX(PSOREF("IRXN"),0),"^",13)<Y:Y,1:$P(^PSRX(PSOREF("IRXN"),0),"^",13))
  1.  S:$G(PSORX("BAR CODE"))&($G(PSOBBC1("FROM"))="NEW") PSOREF("ISSUE DATE")=DT
  1.  K X,X1,X2
  1.  S PSOREF("CS")=0,PSODRUG("DEA")=$P(^PSDRUG($P(^PSRX(PSOREF("IRXN"),0),"^",6),0),"^",3)
  1.  F DEA=1:1 Q:$E(PSODRUG("DEA"),DEA)=""  I $E(+PSODRUG("DEA"),DEA)>1,$E(+PSODRUG("DEA"),DEA)<6 S $P(PSOREF("CS"),"^")=1 S:$E(+PSODRUG("DEA"),DEA)=2 $P(PSOREF("CS"),"^",2)=1
  1.  ;
  1.  D IHSSET  ; IHS/CIA/PLS - 10/27/04 - Setup additional fields for IHS
  1.  ;
  1. 1 S PSONEW("DAYS SUPPLY")=$P(^PSRX(PSOREF("IRXN"),0),"^",8),PSONEW("# OF REFILLS")=$P(^(0),"^",9)
  1.  S PSOREF("FLD")=1 D FILLDT^PSODIR2(.PSOREF) ; Get Fill date
  1.  G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
  1.  ;
  1.  ; IHS/CIA/PLS - 01/06/04 Changed default from MAIL to WINDOW
  1. 2 ;S PSOREF("FLD")=2,PSORX("MAIL/WINDOW")="MAIL" D MW^PSODIR2(.PSOREF)
  1.  S PSOREF("FLD")=2,PSORX("MAIL/WINDOW")="WINDOW" D MW^PSODIR2(.PSOREF)
  1.  ;
  1.  G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
  1.  ;
  1. 3 I $G(DUZ("AG"))="I" S PSOREF("FLD")=3 D CLERK^PSODIR2(.PSOREF) ; Get Clerk Code
  1.  G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
  1.  ;
  1. 4 I $G(DUZ("AG"))="I" S PSOREF("FLD")=4 D EXP^PSODIR2(.PSOREF) ; Get Expiration Date - Indian Health Service ONLY
  1.  G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
  1.  ;
  1. 5 I $G(PSOBILST) D  G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
  1.  .S PSOREF("FLD")=5 D BST^APSPDIR(.PSOREF)  ;GET BILLING STATUS CODE
  1.  ;
  1. 6 I $G(PSOBILST) D  G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
  1.  .S PSOREF("FLD")=6 D INSURER^APSPDIR(.PSOREF)  ;GET INSURER INFO
  1.  ;
  1. 7 I $G(PSONDC)=1 D  G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
  1.  .S PSOREF("FLD")=7 D NDC^APSPDIR(.PSOREF)
  1.  .Q:PSOREF("DFLG")
  1.  .K PSOREF("AWP")  ;ALWAYS KILL AWP IF CHECKING NDC TO RESET
  1.  .K PSOREF("COST")  ;ALWAYS KILL COST IF CHECKING NDC TO RESET
  1.  ;
  1. 8 I $G(PSOAWP)=1 D  G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
  1.  .S PSOREF("FLD")=8 D AWP^APSPDIR(.PSOREF)
  1.  ;
  1. 9 I $G(PSOCOST)=1 D  G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
  1.  .S PSOREF("FLD")=9 D COST^APSPDIR(.PSOREF)  ;GET UNIT COST OF DRUG
  1.  ;
  1. 10 I $G(APSPMAN)>0,$G(APSPMAN)<3 D  G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
  1.  .S PSOREF("FLD")=10 D MANUF^APSPDIR(.PSOREF)  ;GET MANUFACTURER DATA
  1.  ;
  1. 11 I $G(APSPMAN)>0,$G(APSPMAN)<3 D  G:PSOREF("DFLG") END G:PSOREF("FIELD") @PSOREF("FIELD")
  1.  .S PSOREF("FLD")=60 D LOT^APSPDIR(.PSOREF)  ;GET LOT #
  1.  ;IHS/CIA/PLS - End IHS Fields
  1. END ;
  1.  K PSOREF1
  1.  ; IHS/CIA/PLS - 01/27/04 - Setup AWP and COST
  1.  S:('$D(PSOREF("AWP")))&('$G(PSOREF("DFLG"))) PSOREF("AWP")=$$AWP^APSQDAWP($S($D(PSOREF("NDC")):PSOREF("NDC"),1:PSODRUG("NDC")),PSODRUG("IEN"),.TALK)
  1.  S:('$D(PSOREF("COST")))&('$G(PSOREF("DFLG"))) PSOREF("COST")=$$COST^APSQDAWP($S($D(PSOREF("NDC")):PSOREF("NDC"),1:PSODRUG("NDC")),PSODRUG("IEN"),.TALK)
  1.  Q
  1. JUMP ;
  1.  S PSOREF("FIELD")=$S(+Y=22:1,+Y=11:2,+Y=16:3,+Y=29:4,1:PSOREF("FLD"))
  1.  ; IHS/CIA/PLS - 01/27/04 - Added $S for additional fields
  1.  S PSONEW("FIELD")=$S(+Y=9999999.07:5,+Y=9999999.12:6,+Y=27:7,+Y=9999999.06:8,+Y=17:9,+Y=28:10,+Y=24:11,1:PSONEW("FIELD"))
  1.  I PSOREF("FIELD")>PSOREF("FLD") W !,$C(7),"Cannot jump ahead ..",! S PSOREF("FIELD")=PSOREF("FLD")
  1.  Q
  1.  ;
  1. EN(PSOREF) ;
  1.  D START
  1.  Q
  1. PROFILE ;
  1.  S (PSORX("REFILL"),PSORX("RENEW"))=0,PSOX=""
  1.  D ^PSOBUILD
  1.  I '$G(PSOSD) W !,"This patient has no prescriptions" S:'$D(DFN) DFN=PSODFN D GMRA^PSODEM G PROFILEX
  1.  S (PSODRG,PSOX)="" F  S PSODRG=$O(PSOSD(PSODRG)) Q:PSODRG=""  F  S PSOX=$O(PSOSD(PSODRG,PSOX)) Q:PSOX=""  S:$P(PSOSD(PSODRG,PSOX),"^",3)="" PSORX("RENEW")=1 S:$P(PSOSD(PSODRG,PSOX),"^",4)="" PSORX("REFILL")=1
  1.  K PSOX
  1. PROFILEX Q
  1.  ;
  1.  ; IHS/CIA/PLS - 10/27/04 - Setup for additional fields
  1. IHSSET ; EP
  1.  S PSODRUG("IEN")=$P(^PSRX(PSOREF("IRXN"),0),U,6)
  1.  S (PSODRUG("NDC"),PSOREF("NDC"))=$P(^PSDRUG(PSODRUG("IEN"),2),U,4)
  1.  S PSOREF("AWP")=$P($G(^PSDRUG(PSODRUG("IEN"),999999931)),U,2)
  1.  S:'$D(PSOREF("BST")) PSOREF("BST")=$G(PSOBILST)  ; CIA/IHS/PLS - Added with patch 1003 - 04/21/05
  1.  S:$G(^PSDRUG(PSODRUG("IEN"),660))]"" PSOREF("COST")=$P(^PSDRUG(PSODRUG("IEN"),660),"^",6)
  1.  I $D(^PSDRUG(PSODRUG("IEN"),999999924)) D
  1.  .N NODE
  1.  .S NODE=^PSDRUG(PSODRUG("IEN"),999999924)
  1.  .I $G(APSPMAN)=1 D
  1.  ..S PSOREF("MANUFACTURER")=$P(NODE,U,1) S:+PSOREF("MANUFACTURER") PSOREF("MANUFACTURER")=$P(^PS(55.95,PSOREF("MANUFACTURER"),0),U)
  1.  ..S PSOREF("LOT #")=$P(NODE,U,2)
  1.  .I (($G(APSPMAN)=1)!($G(APSPMAN)=2)) S PSOREF("EXPIRATION DATE")=$P(NODE,U,3)
  1.  ; IHS/CIA/PLS - End setup
  1.  Q