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

PSONEW3.m

Go to the documentation of this file. 
  1. PSONEW3 ;IHS/DSD/JCM - EDIT TEMPLATE DURING NEW RX ORDER ENTRY ;04-Jun-2013 12:36;DU
  1.  ;;7.0;OUTPATIENT PHARMACY;**1006,1008,1017**;DEC 1997;Build 40
  1.  ; Modified - IHS/CIA/PLS - 01/02/04 - Lines: New jump labels and JUMP+2
  1.  ;            IHS/MSC/PLS - 08/20/07 - Line label 35 changed to call TRPDCLS^APSPDIR entry point.
  1.  ;                          03/13/08 - Added label 52
  1.  ;                          01/23/09 - Added label 53
  1.  ;                          06/04/13 - Added label 521
  1. START ;
  1.  S (PSONEW("DFLG"),PSONEW("FIELD"),PSONEW3)=0
  1.  ;
  1. 1 S PSONEW("FLD")=1 D ISSDT^PSODIR2(.PSONEW) ; Get Issue Date
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 2 S PSONEW("FLD")=2 D FILLDT^PSODIR2(.PSONEW) ; Get Fill date
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 3 S:$G(POERR) PSONEW("ISSUE DATE")=PSOID
  1.  S PSONEW("FLD")=3 D PTSTAT^PSODIR1(.PSONEW) ; Get Patient Status
  1.  ;K PSTMAX S PSDAYS=PSONEW("DAYS SUPPLY"),PSRF=PSONEW("# OF REFILLS"),PTST=$P(^PS(53,PSONEW("PATIENT STATUS"),0),"^"),PTDY=$P(^(0),"^",3),PTRF=$P(^(0),"^",4) D EDSTAT^PSOUTLA
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 35 ; IHS/CIA/PLS - 01/02/04 - Get Triplicate number
  1.  I $$TRPDCLS^APSPDIR($G(PSOTRIP),$G(PSODRUG("DEA"))) D  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  .S PSONEW("FLD")=35 D TRIP^APSPDIR(.PSONEW)
  1.  ;
  1. 40 ; IHS/CIA/PLS - 01/02/04 - Get NDC Number
  1.  I $G(PSONDC)=1 D  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  .S PSONEW("FLD")=40 D NDC^APSPDIR(.PSONEW)
  1.  .K PSONEW("AWP"),PSONEW("COST")
  1.  ;
  1. 50 ; IHS/CIA/PLS - 01/02/04 - Get AWP Price
  1.  I $G(PSOAWP)=1 D  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  .S PSONEW("FLD")=50 D AWP^APSPDIR(.PSONEW)
  1.  ;
  1. 51 ; IHS/CIA/PLS - 01/02/04 - Get Cost of Drug
  1.  I $G(PSOCOST)=1 D  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  .S PSONEW("FLD")=51 D COST^APSPDIR(.PSONEW)
  1.  ;
  1. 52 ; IHS/MSC/PLS - 03/13/08 - Get SUBSTITUTION
  1.  D  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  .S PSONEW("FLD")=52 D SUBS^APSPDIR(.PSONEW)
  1. 521 ; IHS/MSC/PLS - 06/04/13 - Get Discharge Medication
  1.  D  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  .S PSONEW("FLD")=521 D DSCMED^APSPDIR(.PSONEW)
  1. 53 ; IHS/MSC/PLS - 01/23/09 - Get Cash Due
  1.  I $$GET1^DIQ(9009033,PSOSITE,319,"I") D  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  .S PSONEW("FLD")=53 D CASHDUE^APSPDIR(.PSONEW)
  1.  ; IHS/CIA/PLS - 01/02/04 - Branching logic
  1.  G:(($G(APSPMAN)=3)!($G(APSPMAN)="")) 4 G:$G(APSPMAN)=2 57
  1. 54 ; IHS/CIA/PLS - 01/02/04 - Get Manufacturer data
  1.  S PSONEW("FLD")=54 D MANUF^APSPDIR(.PSONEW)
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 55 ; IHS/CIA/PLS - 01/02/04 - Get Lot #
  1.  S PSONEW("FLD")=55 D LOT^APSPDIR(.PSONEW)
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 57 ; IHS/CIA/PLS - 01/02/04 - Get Expiration Date
  1.  S PSONEW("FLD")=57 D EXPDATE^APSPDIR(.PSONEW)
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 4 S PSONEW("FLD")=4 D PROV^PSODIR(.PSONEW) ; Get Provider
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 101 ; IHS/CIA/PLS - 01/02/04 - Branching logic
  1.  S PSONEW("BST")=PSOBILST G:$G(PSOBILRX)'=1 120
  1. 115 ; IHS/CIA/PLS - 01/02/04 - Billing Status
  1.  S PSONEW("FLD")=115 D BST^APSPDIR(.PSONEW)
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 117 ; IHS/CIA/PLS - 01/02/04 - Get Insurer info
  1.  S PSONEW("FLD")=117 D INSURER^APSPDIR(.PSONEW)
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 120 ; IHS/CIA/PLS - 01/02/04 - Get Chronic Med data
  1.  I $G(APSPCMP) S PSONEW("FLD")=120 D CM^APSPDIR(.PSONEW)
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 5 S PSONEW("FLD")=5 D CLINIC^PSODIR2(.PSONEW) ; Get Clinic
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 6 S PSONEW("FLD")=6 D ^PSODRG ; Get drug and related information
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 7 S PSONEW("FLD")=7 D QTY^PSODIR1(.PSONEW) ; Get quantity
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 8 S PSONEW("FLD")=8 D DAYS^PSODIR1(.PSONEW) ; Get days supply
  1.  ;K PSMAX,PSTMAX S PSDAYS=PSONEW("DAYS SUPPLY"),PSRF=PSONEW("# OF REFILLS"),PTST=$P(^PS(53,PSONEW("PATIENT STATUS"),0),"^"),PTDY=$P(^(0),"^",3),PTRF=$P(^(0),"^",4),PSODEA=PSODRUG("DEA"),CS=0 D EDNEW^PSOUTLA
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 9 S PSONEW("FLD")=9 D REFILL^PSODIR1(.PSONEW) ; Get # of refills
  1.  ;K PSMAX,PSTMAX S PSDAYS=PSONEW("DAYS SUPPLY"),PSRF=PSONEW("# OF REFILLS"),PTST=$P(^PS(53,PSONEW("PATIENT STATUS"),0),"^"),PTDY=$P(^(0),"^",3),PTRF=$P(^(0),"^",4),PSODEA=PSODRUG("DEA"),CS=0 D EDNEW^PSOUTLA
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 10 S PSONEW("FLD")=10 D SIG^PSODIR1(.PSONEW) ; Get sig
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 11 S PSONEW("FLD")=11 D COPIES^PSODIR1(.PSONEW) ; Get # of copies
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 12 S PSONEW("FLD")=12 D MW^PSODIR2(.PSONEW) ; Get Mail/Window Info
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 13 S PSONEW("FLD")=13 D RMK^PSODIR2(.PSONEW) ; Get Remarks
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1.  ; IHS/CIA/PLS - 01/02/04 - Next two lines commented out.
  1. 14 ;I $G(DUZ("AG"))="I" S PSONEW("FLD")=14 D EXP^PSODIR2(.PSONEW) ; Get Expiration Date - Indian Health Service ONLY
  1.  ;G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. 15 S PSONEW("FLD")=15 D CLERK^PSODIR2(.PSONEW) ; Get Clerk Code
  1.  G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
  1.  ;
  1. END ;
  1.  K PSONEW3
  1.  Q
  1.  ;
  1. JUMP ;
  1.  S PSONEW("FIELD")=$S(+Y=3:3,+Y=6:6,+Y=10:10,+Y=7:7,+Y=10.6:11,+Y=8:8,+Y=9:9,+Y=4:4,+Y=29:14,+Y=5:5,+Y=11:12,+Y=12:13,+Y=1:1,+Y=22:2,1:PSONEW("FLD"))
  1.  ; IHS/CIA/PLS - 01/02/04 - Added $S for additional fields
  1.  ; IHS/MSC/PLS - 01/23/09 - Added 53 to $S
  1.  ;S PSONEW("FIELD")=$S(+Y=9999999.06:50,+Y=9999999.02:120,+Y=9999999.07:115,+Y=28:54,+Y=24:55,+Y=26:57,+Y=9999999.12:117,+Y=17:51,+Y=9999999.14:35,1:PSONEW("FIELD"))
  1.  S PSONEW("FIELD")=$S(+Y=9999999.06:50,+Y=9999999.02:120,+Y=9999999.07:115,+Y=28:54,+Y=24:55,+Y=26:57,+Y=9999999.12:117,+Y=17:51,+Y=9999999.14:35,+Y=9999999.26:53,1:PSONEW("FIELD"))
  1.  Q