source: FOIAVistA/tag/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSONEW1.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1PSONEW1 ;BIR/DSD - new Rx order entry ;10/17/92
2 ;;7.0;OUTPATIENT PHARMACY;**46,104,117,143**;DEC 1997
3 ;External reference ^PS(55 supported by DBIA 2228
4 ;
5START ;
6 S (PSONEW("DFLG"),PSONEW("FIELD"),PSONEW1)=0
7 ;
81 S PSONEW("FLD")=1 S PSONEW("FIELD")=0
9 I $P($G(PSOPAR),"^",7)'=1 D MANUAL^PSONRXN ; Get Manual Rx number
10 G:PSONEW("QFLG")!PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
11 ;
122 S PSONEW("FLD")=2 D PTSTAT^PSODIR1(.PSONEW) ; Get Patient Status
13 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
14 ;
153 S PSONEW("FLD")=3 D ^PSODRG ; Get drug and related information
16 G:PSONEW("DFLG") END D EN^PSODIAG ; get ICD diagnosis codes for order
17 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
18 ;
1931 S PSONEW("FLD")=31 D DOSE^PSODIR(.PSONEW) ; Get Dosing
20 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
21 ;
2232 I '$G(PSONEW("ENT")) W !,"Incomplete Dosaging Data!",! K DIRUT G 31
23 S PSONEW("FLD")=32 D INS^PSODIR(.PSONEW) ; Get Patient Instructions
24 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
25 I $P($G(^PS(55,PSODFN,"LAN")),"^") D SINS^PSODIR(.PSONEW)
26 ;
274 D EN^PSOFSIG(.PSONEW) I $O(SIG(0)) S SIGOK=1
28 ;S PSONEW("FLD")=4 D SIG^PSODIR1(.PSONEW) ; Get Rx directions
29 ;G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
30 ;
317 S PSONEW("FLD")=7 D DAYS^PSODIR1(.PSONEW) ; Get days supply
32 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
33 ;
345 S PSONEW("FLD")=5 D QTY^PSODIR1(.PSONEW) ; Get quantity
35 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
36 ;
376 I $P($G(PSOPAR),"^",15) S PSONEW("FLD")=6 D COPIES^PSODIR1(.PSONEW) ; Get label copies
38 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
39 ;
408 S PSONEW("FLD")=8 D REFILL^PSODIR1(.PSONEW) ; Get # of refills
41 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
42 ;
439 S PSONEW("FLD")=9 D PROV^PSODIR(.PSONEW) ; Get Provider
44 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
45 G:$G(DUZ("AG"))'="I" 11
46 ;
4710 Q:$G(DUZ("AG"))'="I" S PSONEW("FLD")=10 D EXP^PSODIR2(.PSONEW) ; Get Expiration Date - Indian Health Service ONLY
48 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
49 ;
5011 S PSONEW("FLD")=11 D CLINIC^PSODIR2(.PSONEW) ; Get Clinic
51 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
52 ;
5312 S PSONEW("FLD")=12 D MW^PSODIR2(.PSONEW) ; Get Mail/Window Info
54 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
55 ;
5613 S PSONEW("FLD")=13 D RMK^PSODIR2(.PSONEW) ; Get Remarks
57 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
58 ;
5914 S PSONEW("FLD")=14 D ISSDT^PSODIR2(.PSONEW) ; Get Issue Date
60 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
61 ;
6215 S PSONEW("FLD")=15 D FILLDT^PSODIR2(.PSONEW) ; Get Fill date
63 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
64 ;
6516 S PSONEW("FLD")=16 D CLERK^PSODIR2(.PSONEW) ; Get Clerk Code
66 G:PSONEW("DFLG") END G:PSONEW("FIELD") @PSONEW("FIELD")
67 ;
68END ;
69 K PSONEW1
70 Q
71 ;
72JUMP ;
73 S PSONEW("FIELD")=$S(+Y=.01:1,+Y=3:2,+Y=6:3,+Y=10:4,+Y=7:5,+Y=10.6:6,+Y=8:7,+Y=9:8,+Y=4:9,+Y=29:10,+Y=5:11,+Y=11:12,+Y=12:13,+Y=1:14,+Y=22:15,+Y=16:16,+Y=113:31,+Y=114:32,1:PSONEW("FLD"))
74 I PSONEW("FIELD")>PSONEW("FLD") W !,$C(7),"Cannot jump ahead ..",! S PSONEW("FIELD")=PSONEW("FLD")
75 Q
Note: See TracBrowser for help on using the repository browser.