source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSDGC2.m@ 1006

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1GMTSDGC2 ; 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 ;
8ICDP(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
25ICDS(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
Note: See TracBrowser for help on using the repository browser.