PSUCS1 ;BIR/DJE - PBM CONTROLLED SUBSTANCE GENERATE RECORDS ;20 OCT 1999
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;
;DBIA(s)
; Reference to file #58.81 supported by DBIA 2520
;
;3.2.5.1. Functional Requirement 1
;3.2.5.2. Functional Requirement 2
; DTTM=DATE/TIME
; PSULOC=PSULOCATION
; PSUTYP=DISPENSING TYPE
; PSUIENDA=TRANSACTION
INIT ;
S PSUCSJB=$G(PSUCSJB,"PSUCS_"_PSUJOB)
;*** THE DEFAULT RECORD INDICATOR IS 'H' AND
;
K ^XTMP(PSUCSJB)
I '$D(^XTMP(PSUCSJB)) D
. S X1=DT,X2=6 D C^%DTC
. S ^XTMP(PSUCSJB,0)=X_"^"_DT_"^ Controlled Substance Extraction"
S FACILITY=PSUSNDR
S PSUSDT=$G(PSUSDT,"")
S PSUEDT=$G(PSUEDT,"")
S PSUEDT=PSUEDT\1+.24
;S PSURI="H" DAM TEST
S PSUMCHK=0
Q
;
EN ;ENTRY POINT
D INIT
S DTTM=PSUSDT
F S DTTM=$O(^PSD(58.81,"AF",DTTM)) Q:(DTTM="")!(DTTM'<PSUEDT) D
.S PSULOC=""
.F S PSULOC=$O(^PSD(58.81,"AF",DTTM,PSULOC)) Q:PSULOC="" D
.. S PSUTYP=""
.. F S PSUTYP=$O(^PSD(58.81,"AF",DTTM,PSULOC,PSUTYP)) Q:PSUTYP="" D
... ;3.2.5.3. Functional Requirement 3
... ;'2'-Dispensed from Pharmacy or '17'- Logged for Patient.
... Q:(PSUTYP'=17)&(PSUTYP'=2)
... ; section 3.2.5.10.
... ; Check for type 17
... S PSUIENDA=""
... F S PSUIENDA=$O(^PSD(58.81,"AF",DTTM,PSULOC,PSUTYP,PSUIENDA)) Q:PSUIENDA="" D
.... ; patient IEN
.... S PSUPIEN(73)=$$VALI^PSUTL(58.81,PSUIENDA,"73")
.... ;
.... ; Screen out test patients
.... Q:$$TESTPAT^PSUTL1(PSUPIEN(73))
.... ; Field # 58.81,3 [DATE/TIME]Field to be extracted***
.... S PSUDTM(3)=$$VALI^PSUTL(58.81,PSUIENDA,"3")
.... ;S PSURI="H" S SENDER=PSUSNDR ;DUZ DAM TEST
.... I PSUTYP=2 D TYP2^PSUCS2 D:'$G(PSUQUIT) BUILDREC^PSUCS5 K PSUSSN,PSUPLC,PSUQUIT ;**9
.... I PSUTYP=17,PSUPIEN(73)'="" D TYP17^PSUCS3 K PSUPLC
.... ; type 17s to be processed after all are gathered
.... ; into ^XTMP(,"MC",LOC,PAT,DRG)
....;3.2.5.5. Functional Requirement 5
D EN^PSUCS17 ; process type 17s that have been gathered
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUCS1 2006 printed Sep 23, 2025@20:03:12 Page 2
PSUCS1 ;BIR/DJE - PBM CONTROLLED SUBSTANCE GENERATE RECORDS ;20 OCT 1999
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;
+3 ;DBIA(s)
+4 ; Reference to file #58.81 supported by DBIA 2520
+5 ;
+6 ;3.2.5.1. Functional Requirement 1
+7 ;3.2.5.2. Functional Requirement 2
+8 ; DTTM=DATE/TIME
+9 ; PSULOC=PSULOCATION
+10 ; PSUTYP=DISPENSING TYPE
+11 ; PSUIENDA=TRANSACTION
INIT ;
+1 SET PSUCSJB=$GET(PSUCSJB,"PSUCS_"_PSUJOB)
+2 ;*** THE DEFAULT RECORD INDICATOR IS 'H' AND
+3 ;
+4 KILL ^XTMP(PSUCSJB)
+5 IF '$DATA(^XTMP(PSUCSJB))
Begin DoDot:1
+6 SET X1=DT
SET X2=6
DO C^%DTC
+7 SET ^XTMP(PSUCSJB,0)=X_"^"_DT_"^ Controlled Substance Extraction"
End DoDot:1
+8 SET FACILITY=PSUSNDR
+9 SET PSUSDT=$GET(PSUSDT,"")
+10 SET PSUEDT=$GET(PSUEDT,"")
+11 SET PSUEDT=PSUEDT\1+.24
+12 ;S PSURI="H" DAM TEST
+13 SET PSUMCHK=0
+14 QUIT
+15 ;
EN ;ENTRY POINT
+1 DO INIT
+2 SET DTTM=PSUSDT
+3 FOR
SET DTTM=$ORDER(^PSD(58.81,"AF",DTTM))
if (DTTM="")!(DTTM'<PSUEDT)
QUIT
Begin DoDot:1
+4 SET PSULOC=""
+5 FOR
SET PSULOC=$ORDER(^PSD(58.81,"AF",DTTM,PSULOC))
if PSULOC=""
QUIT
Begin DoDot:2
+6 SET PSUTYP=""
+7 FOR
SET PSUTYP=$ORDER(^PSD(58.81,"AF",DTTM,PSULOC,PSUTYP))
if PSUTYP=""
QUIT
Begin DoDot:3
+8 ;3.2.5.3. Functional Requirement 3
+9 ;'2'-Dispensed from Pharmacy or '17'- Logged for Patient.
+10 if (PSUTYP'=17)&(PSUTYP'=2)
QUIT
+11 ; section 3.2.5.10.
+12 ; Check for type 17
+13 SET PSUIENDA=""
+14 FOR
SET PSUIENDA=$ORDER(^PSD(58.81,"AF",DTTM,PSULOC,PSUTYP,PSUIENDA))
if PSUIENDA=""
QUIT
Begin DoDot:4
+15 ; patient IEN
+16 SET PSUPIEN(73)=$$VALI^PSUTL(58.81,PSUIENDA,"73")
+17 ;
+18 ; Screen out test patients
+19 if $$TESTPAT^PSUTL1(PSUPIEN(73))
QUIT
+20 ; Field # 58.81,3 [DATE/TIME]Field to be extracted***
+21 SET PSUDTM(3)=$$VALI^PSUTL(58.81,PSUIENDA,"3")
+22 ;S PSURI="H" S SENDER=PSUSNDR ;DUZ DAM TEST
+23 ;**9
IF PSUTYP=2
DO TYP2^PSUCS2
if '$GET(PSUQUIT)
DO BUILDREC^PSUCS5
KILL PSUSSN,PSUPLC,PSUQUIT
+24 IF PSUTYP=17
IF PSUPIEN(73)'=""
DO TYP17^PSUCS3
KILL PSUPLC
+25 ; type 17s to be processed after all are gathered
+26 ; into ^XTMP(,"MC",LOC,PAT,DRG)
+27 ;3.2.5.5. Functional Requirement 5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+28 ; process type 17s that have been gathered
DO EN^PSUCS17
+29 QUIT
