source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHCDG.m@ 1352

Last change on this file since 1352 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.0 KB
Line 
1VAFHCDG ;ALB/CM OUTPATIENT DG1 SEGMENT GENERATOR ;3/30/95
2 ;;5.3;Registration;**91,151,606**;Jun 06, 1996
3 ;
4 ;This routine generates the Outpatient DG1 segment
5 ;for the Philly project
6 ;
7ODG1(DFN,EVENT,EVDT,VPTR,PSTR,PNUM) ;
8 ;
9 ;DFN - Patient File
10 ;EVENT - event number from pivot file
11 ;EVDT - event date/time FileMan
12 ;VPTR - variable pointer
13 ;PSTSR - string of fields
14 ;(if null - required fields, if "A" - supported
15 ;fields, or string of fields seperated by commas")
16 ;PNUM - ID # (optional)
17 ;
18 I '$D(DFN)!('$D(EVENT))!('$D(EVDT))!('$D(VPTR)) Q "-1^Missing parameters, unable to generate DG1 segment"
19 I $D(EVENT) I EVENT'="" S NODE=$$PIVX^VAFHPIVT(EVENT,DFN,EVDT)
20 I $D(EVENT) I EVENT="" K EVENT
21 I '$D(EVENT) S NODE=$$PIVNW^VAFHPIVT(DFN,EVDT,2,VPTR),EVENT=$P(NODE,":")
22 I EVENT<1 Q "-1^Bad event number, unable to generate DG1 segment"
23 S NODE=$P(NODE,":",2)
24 ;
25EN1 ;
26 N HLD,DG1,TD,CODMET,CODE,LOOP,ICD
27 S (CODE,ICD,DG1,ICD,TD,CODMET)=""
28 S QUOT=""""""
29 I '$D(PNUM) S PNUM=1
30 I '$D(PSTR) S PSTR=",2,6,"
31 ;I PSTR="A" S PSTR=$$GETF^VAFHUTL("DG1")
32 I PSTR="A" S PSTR=",2,3,4,5,6,"
33 I PSTR="" S PSTR=",2,6,"
34 I +PSTR=-1 Q "-1^Unable to get fields, can't generate DG1 segment"
35 ;S LOOP=0
36 ;F S LOOP=LOOP+1,HLD=$P(PSTR,",",LOOP) Q:HLD="" D
37 ;.I HLD=2 S CODMET="I9-ICD9"
38 ;.I HLD=3 S CODE=$$COD(NODE) I CODE="" S CODE=QUOT
39 ;.I HLD=4 D
40 ;..I '$D(CODE) S CODE=$$COD(NODE)
41 ;..I +CODE>0 S ICD=$$DES(CODE) I ICD="" S ICD=QUOT
42 ;..I +CODE=0 S ICD=QUOT
43 ;.I HLD=5 S TD=$$HLDATE^HLFNC(EVDT) I TD="" S TD=QUOT
44 ;
45 I PSTR[",2," S CODMET="I9-ICD9"
46 I PSTR[",3," S CODE=$$COD(NODE) I CODE="" S CODE=QUOT
47 I PSTR[",4," DO
48 . I '$D(CODE) S CODE=$$COD(NODE)
49 . I +CODE>0 S ICD=$$DES(CODE) I ICD="" S ICD=QUOT
50 . I +CODE=0 S ICD=QUOT
51 I PSTR[",5," S TD=$$HLDATE^HLFNC(EVDT) I TD="" S TD=QUOT
52 ;
53 S DG1=HLFS_CODE_HLFS_ICD_HLFS_TD
54 I DG1?1"^"."^" Q "-1^Unable to populate fields "_PSTR_" - can't generate DG1 segment"
55 S DG1="DG1"_HLFS_PNUM_HLFS_CODMET_DG1
56 K NODE,QUOT
57 Q DG1
58 ;
59COD(ZNODE) ;
60 N OPTR,CDX,PTR,FILE
61 ;
62 S OPTR=$P(ZNODE,"^",5),PTR=+OPTR,FILE=$P(OPTR,";",2)
63 I PTR=""!(FILE'="SCE(") Q QUOT
64 ;
65 ;try get primary dx first
66 S CDX=$$GETPDX(PTR) I CDX DO Q CDX
67 . S CDX=+$P($G(^ICD9(CDX,0)),"^")
68 . I 'CDX S CDX=QUOT
69 ;
70 Q QUOT
71 ;
72DES(CDX) ;
73 ;Get description/name of diagnosis from diagnostic code
74 ;
75 I CDX="" Q QUOT
76 I CDX'?.N1".".N S CDX=CDX_"."
77 I '$D(^ICD9("AB",CDX)) D
78 .I $D(^ICD9("AB",CDX_" ")) S CDX=CDX_" " Q
79 .I $D(^ICD9("AB",CDX_"0")) S CDX=CDX_"0" Q
80 .I $D(^ICD9("AB",CDX_"0 ")) S CDX=CDX_"0 " Q
81 .I $D(^ICD9("AB",CDX_"00")) S CDX=CDX_"00" Q
82 .I $D(^ICD9("AB",CDX_"00 ")) S CDX=CDX_"00 " Q
83 I '$D(^ICD9("AB",CDX)) Q QUOT
84 S CDX=$O(^ICD9("AB",CDX,""))
85 I CDX="" Q QUOT
86 I '$D(^ICD9(CDX,0)) Q QUOT
87 S CDX=$$ICDDX^ICDCODE(CDX,$G(EVDT))
88 S CDX=$S(+CDX<1:QUOT,1:$P(CDX,"^",4))
89 Q CDX
90 ;
91GETPDX(PTR) ;returns first primary diagnois or 0
92 N VAENC0,VADX
93 S VAENC0=$$SCE^DGSDU(PTR)
94 I PTR,+VAENC0,$$DATE^SCDXUTL(+VAENC0)
95 E Q 0
96 S CDX=0
97 D GETDX^SDOE(PTR,"VADX")
98 S VADX=0
99 F S VADX=$O(VADX(VADX)) Q:'VADX DO Q:CDX["^P"
100 . I $P(VADX(VADX),"^",12)="P" S CDX=+VADX(VADX)_"^P"
101 Q +CDX
Note: See TracBrowser for help on using the repository browser.