- 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