source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUCS1.m@ 808

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1PSUCS1 ;BIR/DJE - PBM CONTROLLED SUBSTANCE GENERATE RECORDS ;20 OCT 1999
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;
4 ;DBIA(s)
5 ; Reference to file #58.81 supported by DBIA 2520
6 ;
7 ;3.2.5.1. Functional Requirement 1
8 ;3.2.5.2. Functional Requirement 2
9 ; DTTM=DATE/TIME
10 ; PSULOC=PSULOCATION
11 ; PSUTYP=DISPENSING TYPE
12 ; PSUIENDA=TRANSACTION
13INIT ;
14 S PSUCSJB=$G(PSUCSJB,"PSUCS_"_PSUJOB)
15 ;*** THE DEFAULT RECORD INDICATOR IS 'H' AND
16 ;
17 K ^XTMP(PSUCSJB)
18 I '$D(^XTMP(PSUCSJB)) D
19 . S X1=DT,X2=6 D C^%DTC
20 . S ^XTMP(PSUCSJB,0)=X_"^"_DT_"^ Controlled Substance Extraction"
21 S FACILITY=PSUSNDR
22 S PSUSDT=$G(PSUSDT,"")
23 S PSUEDT=$G(PSUEDT,"")
24 S PSUEDT=PSUEDT\1+.24
25 ;S PSURI="H" DAM TEST
26 S PSUMCHK=0
27 Q
28 ;
29EN ;ENTRY POINT
30 D INIT
31 S DTTM=PSUSDT
32 F S DTTM=$O(^PSD(58.81,"AF",DTTM)) Q:(DTTM="")!(DTTM'<PSUEDT) D
33 .S PSULOC=""
34 .F S PSULOC=$O(^PSD(58.81,"AF",DTTM,PSULOC)) Q:PSULOC="" D
35 .. S PSUTYP=""
36 .. F S PSUTYP=$O(^PSD(58.81,"AF",DTTM,PSULOC,PSUTYP)) Q:PSUTYP="" D
37 ... ;3.2.5.3. Functional Requirement 3
38 ... ;'2'-Dispensed from Pharmacy or '17'- Logged for Patient.
39 ... Q:(PSUTYP'=17)&(PSUTYP'=2)
40 ... ; section 3.2.5.10.
41 ... ; Check for type 17
42 ... S PSUIENDA=""
43 ... F S PSUIENDA=$O(^PSD(58.81,"AF",DTTM,PSULOC,PSUTYP,PSUIENDA)) Q:PSUIENDA="" D
44 .... ; patient IEN
45 .... S PSUPIEN(73)=$$VALI^PSUTL(58.81,PSUIENDA,"73")
46 .... ;
47 .... ; Screen out test patients
48 .... Q:$$TESTPAT^PSUTL1(PSUPIEN(73))
49 .... ; Field # 58.81,3 [DATE/TIME]Field to be extracted***
50 .... S PSUDTM(3)=$$VALI^PSUTL(58.81,PSUIENDA,"3")
51 .... ;S PSURI="H" S SENDER=PSUSNDR ;DUZ DAM TEST
52 .... I PSUTYP=2 D TYP2^PSUCS2 D:'$G(PSUQUIT) BUILDREC^PSUCS5 K PSUSSN,PSUPLC,PSUQUIT ;**9
53 .... I PSUTYP=17,PSUPIEN(73)'="" D TYP17^PSUCS3 K PSUPLC
54 .... ; type 17s to be processed after all are gathered
55 .... ; into ^XTMP(,"MC",LOC,PAT,DRG)
56 ....;3.2.5.5. Functional Requirement 5
57 D EN^PSUCS17 ; process type 17s that have been gathered
58 Q
Note: See TracBrowser for help on using the repository browser.