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