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

VAFHCDG.m

Go to the documentation of this file. 
  1. VAFHCDG ;ALB/CM OUTPATIENT DG1 SEGMENT GENERATOR ;3/30/95
  1.  ;;5.3;Registration;**91,151,606**;Jun 06, 1996
  1.  ;
  1.  ;This routine generates the Outpatient DG1 segment
  1.  ;for the Philly project
  1.  ;
  1. ODG1(DFN,EVENT,EVDT,VPTR,PSTR,PNUM) ;
  1.  ;
  1.  ;DFN - Patient File
  1.  ;EVENT - event number from pivot file
  1.  ;EVDT - event date/time FileMan
  1.  ;VPTR - variable pointer
  1.  ;PSTSR - string of fields
  1.  ;(if null - required fields, if "A" - supported
  1.  ;fields, or string of fields seperated by commas")
  1.  ;PNUM - ID # (optional)
  1.  ;
  1.  I '$D(DFN)!('$D(EVENT))!('$D(EVDT))!('$D(VPTR)) Q "-1^Missing parameters, unable to generate DG1 segment"
  1.  I $D(EVENT) I EVENT'="" S NODE=$$PIVX^VAFHPIVT(EVENT,DFN,EVDT)
  1.  I $D(EVENT) I EVENT="" K EVENT
  1.  I '$D(EVENT) S NODE=$$PIVNW^VAFHPIVT(DFN,EVDT,2,VPTR),EVENT=$P(NODE,":")
  1.  I EVENT<1 Q "-1^Bad event number, unable to generate DG1 segment"
  1.  S NODE=$P(NODE,":",2)
  1.  ;
  1. EN1 ;
  1.  N HLD,DG1,TD,CODMET,CODE,LOOP,ICD
  1.  S (CODE,ICD,DG1,ICD,TD,CODMET)=""
  1.  S QUOT=""""""
  1.  I '$D(PNUM) S PNUM=1
  1.  I '$D(PSTR) S PSTR=",2,6,"
  1.  ;I PSTR="A" S PSTR=$$GETF^VAFHUTL("DG1")
  1.  I PSTR="A" S PSTR=",2,3,4,5,6,"
  1.  I PSTR="" S PSTR=",2,6,"
  1.  I +PSTR=-1 Q "-1^Unable to get fields, can't generate DG1 segment"
  1.  ;S LOOP=0
  1.  ;F  S LOOP=LOOP+1,HLD=$P(PSTR,",",LOOP) Q:HLD=""  D
  1.  ;.I HLD=2 S CODMET="I9-ICD9"
  1.  ;.I HLD=3 S CODE=$$COD(NODE) I CODE="" S CODE=QUOT
  1.  ;.I HLD=4 D
  1.  ;..I '$D(CODE) S CODE=$$COD(NODE)
  1.  ;..I +CODE>0 S ICD=$$DES(CODE) I ICD="" S ICD=QUOT
  1.  ;..I +CODE=0 S ICD=QUOT
  1.  ;.I HLD=5 S TD=$$HLDATE^HLFNC(EVDT) I TD="" S TD=QUOT
  1.  ;
  1.  I PSTR[",2," S CODMET="I9-ICD9"
  1.  I PSTR[",3," S CODE=$$COD(NODE) I CODE="" S CODE=QUOT
  1.  I PSTR[",4," DO
  1.  . I '$D(CODE) S CODE=$$COD(NODE)
  1.  . I +CODE>0 S ICD=$$DES(CODE) I ICD="" S ICD=QUOT
  1.  . I +CODE=0 S ICD=QUOT
  1.  I PSTR[",5," S TD=$$HLDATE^HLFNC(EVDT) I TD="" S TD=QUOT
  1.  ;
  1.  S DG1=HLFS_CODE_HLFS_ICD_HLFS_TD
  1.  I DG1?1"^"."^" Q "-1^Unable to populate fields "_PSTR_" - can't generate DG1 segment"
  1.  S DG1="DG1"_HLFS_PNUM_HLFS_CODMET_DG1
  1.  K NODE,QUOT
  1.  Q DG1
  1.  ;
  1. COD(ZNODE) ;
  1.  N OPTR,CDX,PTR,FILE
  1.  ;
  1.  S OPTR=$P(ZNODE,"^",5),PTR=+OPTR,FILE=$P(OPTR,";",2)
  1.  I PTR=""!(FILE'="SCE(") Q QUOT
  1.  ;
  1.  ;try get primary dx first
  1.  S CDX=$$GETPDX(PTR) I CDX DO  Q CDX
  1.  . S CDX=+$P($G(^ICD9(CDX,0)),"^")
  1.  . I 'CDX S CDX=QUOT
  1.  ;
  1.  Q QUOT
  1.  ;
  1. DES(CDX) ;
  1.  ;Get description/name of diagnosis from diagnostic code
  1.  ;
  1.  I CDX="" Q QUOT
  1.  I CDX'?.N1".".N S CDX=CDX_"."
  1.  I '$D(^ICD9("AB",CDX)) D
  1.  .I $D(^ICD9("AB",CDX_" ")) S CDX=CDX_" " Q
  1.  .I $D(^ICD9("AB",CDX_"0")) S CDX=CDX_"0" Q
  1.  .I $D(^ICD9("AB",CDX_"0 ")) S CDX=CDX_"0 " Q
  1.  .I $D(^ICD9("AB",CDX_"00")) S CDX=CDX_"00" Q
  1.  .I $D(^ICD9("AB",CDX_"00 ")) S CDX=CDX_"00 " Q
  1.  I '$D(^ICD9("AB",CDX)) Q QUOT
  1.  S CDX=$O(^ICD9("AB",CDX,""))
  1.  I CDX="" Q QUOT
  1.  I '$D(^ICD9(CDX,0)) Q QUOT
  1.  S CDX=$$ICDDX^ICDCODE(CDX,$G(EVDT))
  1.  S CDX=$S(+CDX<1:QUOT,1:$P(CDX,"^",4))
  1.  Q CDX
  1.  ;
  1. GETPDX(PTR) ;returns first primary diagnois or 0
  1.  N VAENC0,VADX
  1.  S VAENC0=$$SCE^DGSDU(PTR)
  1.  I PTR,+VAENC0,$$DATE^SCDXUTL(+VAENC0)
  1.  E  Q 0
  1.  S CDX=0
  1.  D GETDX^SDOE(PTR,"VADX")
  1.  S VADX=0
  1.  F  S VADX=$O(VADX(VADX)) Q:'VADX  DO  Q:CDX["^P"
  1.  . I $P(VADX(VADX),"^",12)="P" S CDX=+VADX(VADX)_"^P"
  1.  Q +CDX