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

PSUDEM9.m

Go to the documentation of this file.
  1. PSUDEM9 ;BIR/DAM - CPT Codes for Inpatient PTF Record Extract ; 20 DEC 2001
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1. ;
  1. ;DBIA's
  1. ; Reference to file 45 supported by DBIA 3511
  1. ; Reference to file 80.1 supported by DBIA 10083
  1. ;
  1. EN ;EN Called from PSUDEM8
  1. D CPTP
  1. D P
  1. D AO
  1. D FIN
  1. ;
  1. Q
  1. ;
  1. CPTP ;Find CPT pointers for the ^DGPT(D0,"401P" node by $ ordering
  1. ;through the ^DGPT(D0,"AP",Pointer) cross reference
  1. ;
  1. S I=17
  1. S PSUAP=0
  1. F S PSUAP=$O(^DGPT(PSUC,"AP",PSUAP)) Q:'PSUAP D
  1. .N PSUCPT
  1. .S PSUCPT=$P($G(^ICD0(PSUAP,0)),U) ;CPT code
  1. .I $G(PSUCPT) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,I,PSUCPT)="" ;Set temp global
  1. .S I=I+1
  1. Q
  1. ;
  1. P ;Find CPT pointers for the ^DGPT(D0,"P" node by $O through
  1. ;the ^DGPT(D0,"P","AP6",pointer,D1) cross reference
  1. ;
  1. S I=22
  1. S PSUP=0
  1. F S PSUP=$O(^DGPT(PSUC,"P","AP6",PSUP)) Q:'PSUP D
  1. .N PSUCPT
  1. .S PSUCPT=$P($G(^ICD0(PSUP,0)),U) ;CPT code
  1. .I $G(PSUCPT) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,I,PSUCPT)="" ;Set temp global
  1. .D DEL
  1. .S I=I+1
  1. Q
  1. ;
  1. DEL ;Delete duplicates
  1. ;
  1. F N=17:1:21 I $D(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,N,PSUCPT)) D
  1. .K ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,I,PSUCPT)
  1. Q
  1. ;
  1. AO ;Find CPT pointers for the ^DGPT(D0,"P" node by $O through
  1. ;the ^DGPT(D0,"S","AO",pointer,D1) cross reference.
  1. ;
  1. S I=27
  1. S PSUBP=0
  1. F S PSUBP=$O(^DGPT(PSUC,"S","AO",PSUBP)) Q:'PSUBP D
  1. .N PSUCPT
  1. .S PSUCPT=$P($G(^ICD0(PSUBP,0)),U) ;CPT code
  1. .I $G(PSUCPT) S ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,I,PSUCPT)="" ;Set temp global
  1. .D DEL1
  1. .S I=I+1
  1. Q
  1. ;
  1. DEL1 ;Delete duplicates
  1. ;
  1. F N=17:1:26 I $D(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,N,PSUCPT)) D
  1. .K ^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,I,PSUCPT)
  1. Q
  1. ;
  1. FIN ;$O through temp global, and set codes into the Inpatient Record
  1. ;global, ^XTMP("PSU_"_PSUJOB,"PSUIPV"
  1. ;
  1. S T=0,N=29
  1. F S T=$O(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,T)) Q:'T Q:N=44 D
  1. .S PSUIDF=0
  1. .F S PSUIDF=$O(^XTMP("PSU_"_PSUJOB,"PSUTMP3",PSUC,T,PSUIDF)) Q:'PSUIDF D
  1. ..S $P(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC),U,N)=PSUIDF
  1. ..S N=N+1
  1. ;
  1. F N=29:1:44 I '$P(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC),U,N) D
  1. .S $P(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC),U,N)="" ;Set unfilled pieces to null
  1. S $P(^XTMP("PSU_"_PSUJOB,"PSUIPV",PSUC),U,44)="" ;Place "^" at end of record
  1. Q