- 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 Feb 18, 2025@23:53:35 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