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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUDEM6 1086 printed Dec 13, 2024@02:27:48 Page 2
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
