| 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
|
|---|
