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

PSUDEM6.m

Go to the documentation of this file.
  1. PSUDEM6 ;BIR/DAM - CPT Codes for Outpatient Visits Extract ; 20 DEC 2001
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1. ;
  1. ;DBIA's
  1. ; Reference to file 81 supported by DBIA 2815
  1. ;
  1. EN ;EN Called from PSUDEM3
  1. D CPT
  1. D FIN
  1. ;
  1. Q
  1. ;
  1. CPT ;Find CPT codes and place into temp global
  1. ;
  1. N PSUCPT1
  1. I $G(PSUCPT) S PSUCPT1=$P($G(^ICPT(PSUCPT,0)),U)
  1. I '$G(PSUCPT) S PSUCPT1="NULL"
  1. I (PSUVIEN'="")&(PSUCPT1'="") D
  1. .S ^XTMP("PSU_"_PSUJOB,"PSUTMP2",PSUVIEN,PSUCPT1)=""
  1. Q
  1. ;
  1. FIN ;$O through temp global, and set codes into the Outpatient Visit
  1. ;Encounter global, ^XTMP("PSU_"_PSUJOB,"PSUOPV"
  1. ;
  1. S PSUIDF=0
  1. S I=17
  1. F S PSUIDF=$O(^XTMP("PSU_"_PSUJOB,"PSUTMP2",PSUVIEN,PSUIDF)) Q:'PSUIDF Q:I=27 D
  1. .I PSUIDF="NULL" S $P(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,I)=""
  1. .I PSUIDF'="NULL" S $P(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,I)=PSUIDF
  1. .S I=I+1
  1. ;
  1. F N=27:1:26 I $P($G(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN)),U,N)="" D
  1. .S $P(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,N)=""
  1. S $P(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUVIEN),U,27)="" ;set closing "^"
  1. Q