Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSUCS1

PSUCS1.m

Go to the documentation of this file.
  1. PSUCS1 ;BIR/DJE - PBM CONTROLLED SUBSTANCE GENERATE RECORDS ;20 OCT 1999
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1. ;
  1. ;DBIA(s)
  1. ; Reference to file #58.81 supported by DBIA 2520
  1. ;
  1. ;3.2.5.1. Functional Requirement 1
  1. ;3.2.5.2. Functional Requirement 2
  1. ; DTTM=DATE/TIME
  1. ; PSULOC=PSULOCATION
  1. ; PSUTYP=DISPENSING TYPE
  1. ; PSUIENDA=TRANSACTION
  1. INIT ;
  1. S PSUCSJB=$G(PSUCSJB,"PSUCS_"_PSUJOB)
  1. ;*** THE DEFAULT RECORD INDICATOR IS 'H' AND
  1. ;
  1. K ^XTMP(PSUCSJB)
  1. I '$D(^XTMP(PSUCSJB)) D
  1. . S X1=DT,X2=6 D C^%DTC
  1. . S ^XTMP(PSUCSJB,0)=X_"^"_DT_"^ Controlled Substance Extraction"
  1. S FACILITY=PSUSNDR
  1. S PSUSDT=$G(PSUSDT,"")
  1. S PSUEDT=$G(PSUEDT,"")
  1. S PSUEDT=PSUEDT\1+.24
  1. ;S PSURI="H" DAM TEST
  1. S PSUMCHK=0
  1. Q
  1. ;
  1. EN ;ENTRY POINT
  1. D INIT
  1. S DTTM=PSUSDT
  1. F S DTTM=$O(^PSD(58.81,"AF",DTTM)) Q:(DTTM="")!(DTTM'<PSUEDT) D
  1. .S PSULOC=""
  1. .F S PSULOC=$O(^PSD(58.81,"AF",DTTM,PSULOC)) Q:PSULOC="" D
  1. .. S PSUTYP=""
  1. .. F S PSUTYP=$O(^PSD(58.81,"AF",DTTM,PSULOC,PSUTYP)) Q:PSUTYP="" D
  1. ... ;3.2.5.3. Functional Requirement 3
  1. ... ;'2'-Dispensed from Pharmacy or '17'- Logged for Patient.
  1. ... Q:(PSUTYP'=17)&(PSUTYP'=2)
  1. ... ; section 3.2.5.10.
  1. ... ; Check for type 17
  1. ... S PSUIENDA=""
  1. ... F S PSUIENDA=$O(^PSD(58.81,"AF",DTTM,PSULOC,PSUTYP,PSUIENDA)) Q:PSUIENDA="" D
  1. .... ; patient IEN
  1. .... S PSUPIEN(73)=$$VALI^PSUTL(58.81,PSUIENDA,"73")
  1. .... ;
  1. .... ; Screen out test patients
  1. .... Q:$$TESTPAT^PSUTL1(PSUPIEN(73))
  1. .... ; Field # 58.81,3 [DATE/TIME]Field to be extracted***
  1. .... S PSUDTM(3)=$$VALI^PSUTL(58.81,PSUIENDA,"3")
  1. .... ;S PSURI="H" S SENDER=PSUSNDR ;DUZ DAM TEST
  1. .... I PSUTYP=2 D TYP2^PSUCS2 D:'$G(PSUQUIT) BUILDREC^PSUCS5 K PSUSSN,PSUPLC,PSUQUIT ;**9
  1. .... I PSUTYP=17,PSUPIEN(73)'="" D TYP17^PSUCS3 K PSUPLC
  1. .... ; type 17s to be processed after all are gathered
  1. .... ; into ^XTMP(,"MC",LOC,PAT,DRG)
  1. ....;3.2.5.5. Functional Requirement 5
  1. D EN^PSUCS17 ; process type 17s that have been gathered
  1. Q