source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR9PCD.m@ 1639

Last change on this file since 1639 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.1 KB
RevLine 
[613]1RMPR9PCD ;HOIFO/HNC - PURCHASE ORDER CHECK PA AUTHORIZATION ;JAN 2003
2 ;;3.0;PROSTHETICS;**90**;Feb 09, 1996
3 ;
4 Q
5B1(DUZ,SITE,RMPR668) G B2
6EN1(RESULTS,DUZ,SITE,RMPR668) ;broker entry point
7B2 ;
8 I '$D(^PRC(440.5,"H",DUZ)),'$D(^PRC(440.5,"C",DUZ)) S RESULTS(0)="1^You are not an authorized Purchase Card User, CONTACT FISCAL!"
9 S RMPRDFN=$P(^RMPR(668,RMPR668,0),U,2)
10 I '$D(^RMPR(665,RMPRDFN,0)) S RESULTS(0)="1^Patient not defined in PROSTHETICS PATIENT FILE please use the option: AP Add/Edit Patient to Prosthetics and try again." Q
11 S (RMPRWHO,RMPRSC)="",(LINE,ALL)=0
12 S RMPRSC=$O(^RMPR(669.9,"PA",DUZ,RMPRSC)) Q:RMPRSC="" D
13 . I '$D(^RMPR(669.9,RMPRSC,0)) Q
14 . I '$D(^RMPR(669.9,RMPRSC,5,"B",DUZ)) Q
15 . S RMPRWHO=$O(^RMPR(669.9,RMPRSC,5,"B",DUZ,""))
16 I RMPRWHO="" S RESULTS(0)="1^User Not Defined in Site Parmeters File." Q
17 S PPASSN=$P($G(^VA(200,DUZ,1)),U,9)
18 I PPASSN="" S RESULTS(0)="1^User Does Not have an SSN in File 200." Q
19 ;
20 D NOW^%DTC
21 K DD,DO
22 ;purchasing agent SSN
23 S $P(RESULTS(0),U,1)=PPASSN
24 S $P(RESULTS(0),U,2)=RMPRWHO
25 S $P(RESULTS(0),U,3)=RMPRDFN
26 Q
27EXIT ;common exit point
28 ;END
Note: See TracBrowser for help on using the repository browser.