1 | GMTSDGC2 ; SLC/SBW,KER - Extended ADT Hist (cont) ; 03/24/2004
|
---|
2 | ;;2.7;Health Summary;**28,49,71**;Oct 20, 1995
|
---|
3 | ;
|
---|
4 | ; External References
|
---|
5 | ; DBIA 1372 ^DGPT(
|
---|
6 | ; DBIA 3390 $$ICDOP^ICDCODE
|
---|
7 | ;
|
---|
8 | ICDP(DFN,PTF) ; Module For History of PTF Procedures
|
---|
9 | Q:'$D(^DGPT(PTF,"P"))
|
---|
10 | N II,PRX,X,IX,GMP,GTA,O,O1,LN1
|
---|
11 | S II=0
|
---|
12 | F S II=$O(^DGPT(PTF,"P",II)) Q:'II S PRX=^DGPT(PTF,"P",II,0),X=$P(PRX,U,1),IX=9999999-X D REGDT4^GMTSU D
|
---|
13 | . S GMP(IX)="Procedure "_X F GTA=5:1:9 D
|
---|
14 | . . N ICDP,ICDI,ICDX Q:$P(PRX,U,GTA)=""
|
---|
15 | . . S ICDI=+($P(PRX,U,GTA)) Q:+ICDI'>0
|
---|
16 | . . S ICDX=$$ICDOP^ICDCODE(+ICDI)
|
---|
17 | . . S ICDP(80.1,ICDI,.01)=$P(ICDX,"^",2)
|
---|
18 | . . S ICDP(80.1,ICDI,4)=$P(ICDX,"^",5)
|
---|
19 | . . I $D(ICDP(80.1,ICDI)) D
|
---|
20 | . . . S GMP(IX,GTA)=$E(ICDP(80.1,ICDI,4),1,45)_U_ICDP(80.1,ICDI,.01)
|
---|
21 | I $D(GMP) S O=0 F S O=$O(GMP(O)) Q:O="" D
|
---|
22 | . S O1=0,LN1=1
|
---|
23 | . F S O1=$O(GMP(O,O1)) Q:O1="" D CKP^GMTSUP Q:$D(GMTSQIT) S:GMTSNPG LN1=1 W:LN1 ?2,GMP(O) W ?23,$P(GMP(O,O1),U),?69,$P(GMP(O,O1),U,2),! S LN1=0
|
---|
24 | Q
|
---|
25 | ICDS(DFN,PTF) ; Module for history of PTF surgery episodes
|
---|
26 | Q:'$D(^DGPT(PTF,"S"))
|
---|
27 | N II,SURG,X,IX,GMS,GMA,O,O1,LN1
|
---|
28 | S II=0
|
---|
29 | F S II=$O(^DGPT(PTF,"S",II)) Q:'II S SURG=^DGPT(PTF,"S",II,0),X=$P(SURG,U,1),IX=9999999-X D REGDT4^GMTSU D
|
---|
30 | . ; Load Surgery entries into GMS array in inverted sequence
|
---|
31 | . S GMS(IX)=" Surgery "_X F GMA=8:1:12 D
|
---|
32 | . . ; Surgery Line
|
---|
33 | . . N ICDS,ICDI,ICDX
|
---|
34 | . . S ICDI=+($P(SURG,U,GMA)) Q:+ICDI'>0
|
---|
35 | . . S ICDX=$$ICDOP^ICDCODE(+ICDI)
|
---|
36 | . . S ICDS(80.1,ICDI,.01)=$P(ICDX,"^",2)
|
---|
37 | . . S ICDS(80.1,ICDI,4)=$P(ICDX,"^",5)
|
---|
38 | . . I $D(ICDS(80.1,ICDI)) S GMS(IX,GMA)=$E(ICDS(80.1,ICDI,4),1,45)_U_ICDS(80.1,ICDI,.01)
|
---|
39 | I $D(GMS) S O=0 F S O=$O(GMS(O)) Q:O="" D
|
---|
40 | . S O1=0,LN1=1
|
---|
41 | . F S O1=$O(GMS(O,O1)) Q:O1="" D CKP^GMTSUP Q:$D(GMTSQIT) S:GMTSNPG LN1=1 W:LN1 ?2,GMS(O) W ?23,$P(GMS(O,O1),U),?69,$P(GMS(O,O1),U,2),! S LN1=0
|
---|
42 | Q
|
---|