PSUCS1.m

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

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