PSUDEM6.m

PSUDEM6 ;BIR/DAM - CPT Codes for Outpatient Visits Extract ; 20 DEC 2001

 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005

 ;

 ;DBIA's

 ; Reference to file 81 supported by DBIA 2815

 ;

EN ;EN  Called from PSUDEM3

 D CPT

 D FIN

 ;

 Q

 ;

CPT ;Find CPT codes and place into temp global

 ;

 N PSUCPT1

 I $G(PSUCPT) S PSUCPT1=$P($G(^ICPT(PSUCPT,0)),U)

 I '$G(PSUCPT) S PSUCPT1="NULL"

 I (PSUVIEN'="")&(PSUCPT1'="") D

 .S ^XTMP("PSU_"_PSUJOB,"PSUTMP2",PSUVIEN,PSUCPT1)=""

 Q 

 ;

FIN ;$O through temp global, and set codes into the Outpatient Visit

 ;Encounter global, ^XTMP("PSU_"_PSUJOB,"PSUOPV"

 ;

 S PSUIDF=0

 S I=17

 F  S PSUIDF=$O(^XTMP("PSU_"_PSUJOB,"PSUTMP2",PSUVIEN,PSUIDF)) Q:'PSUIDF  Q:I=27  D

 .I PSUIDF="NULL" S $P(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,I)=""

 .I PSUIDF'="NULL" S $P(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,I)=PSUIDF

 .S I=I+1

 ;

 F N=27:1:26 I $P($G(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN)),U,N)="" D

 .S $P(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,N)=""

 S $P(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,27)=""   ;set closing "^"

 Q

PSUDEM6   ;BIR/DAM - CPT Codes for Outpatient Visits Extract ; 20 DEC 2001

 +1       ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005

 +2       ;

 +3       ;DBIA's

 +4       ; Reference to file 81 supported by DBIA 2815

 +5       ;

EN        ;EN  Called from PSUDEM3

 +1        DO CPT

 +2        DO FIN

 +3       ;

 +4        QUIT 

 +5       ;

CPT       ;Find CPT codes and place into temp global

 +1       ;

 +2        NEW PSUCPT1

 +3        IF $GET(PSUCPT)

               SET PSUCPT1=$PIECE($GET(^ICPT(PSUCPT,0)),U)

 +4        IF '$GET(PSUCPT)

               SET PSUCPT1="NULL"

 +5        IF (PSUVIEN'="")&(PSUCPT1'="")

               Begin DoDot:1

 +6                SET ^XTMP("PSU_"_PSUJOB,"PSUTMP2",PSUVIEN,PSUCPT1)=""

               End DoDot:1

 +7        QUIT 

 +8       ;

FIN       ;$O through temp global, and set codes into the Outpatient Visit

 +1       ;Encounter global, ^XTMP("PSU_"_PSUJOB,"PSUOPV"

 +2       ;

 +3        SET PSUIDF=0

 +4        SET I=17

 +5        FOR 

               SET PSUIDF=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUTMP2",PSUVIEN,PSUIDF))

               IF 'PSUIDF

                   QUIT 

               IF I=27

                   QUIT 

               Begin DoDot:1

 +6                IF PSUIDF="NULL"

                       SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,I)=""

 +7                IF PSUIDF'="NULL"

                       SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,I)=PSUIDF

 +8                SET I=I+1

               End DoDot:1

 +9       ;

 +10       FOR N=27:1:26

               IF $PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN)),U,N)=""

                   Begin DoDot:1

 +11                   SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,N)=""

                   End DoDot:1

 +12      ;set closing "^"

           SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,27)=""

 +13       QUIT