| 1 | PSUCS1 ;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
|
|---|
| 13 | INIT ;
|
|---|
| 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 | ;
|
|---|
| 29 | EN ;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
|
|---|
