source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSDGP.m@ 846

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1GMTSDGP ; SLC/TRS,KER/NDBI - PTF Surgeries/Procedures ; 03/24/2004 [4/1/04 2:55pm]
2 ;;2.7;Health Summary;**28,49,60,71**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 3390 $$ICDOP^ICDCODE
6 ; DBIA 1372 ^DGPT(
7 ; DBIA 1372 ^DGPT("B"
8 ; DBIA 2929 OPC^A7RHSM
9 ; DBIA 2929 PRC^A7RHSM
10 ;
11ENS ; Module For History of PTF Surgery Episodes
12 I $D(GMTSNDM),GMTSNDM>0 S CNTR=GMTSNDM
13 E S CNTR=100
14 S T1=GMTSEND,T2=GMTSBEG,GMCZ=0
15 S PTF=0
16 F S PTF=$O(^DGPT("B",DFN,PTF)) Q:PTF="" D ICDS
17 D:$$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU) OPC^A7RHSM
18 I $D(GMS) S O=0 F I=1:1 S O=$O(GMS(O)) Q:O="" Q:'CNTR S CNTR=CNTR-1 S O1=0,LN1=1 F I=1:1 S O1=$O(GMS(O,O1)) Q:O1="" D CKP^GMTSUP Q:$D(GMTSQIT) S:GMTSNPG LN1=1 W:LN1 GMS(O) W ?21,$P(GMS(O,O1),U),?68,$P(GMS(O,O1),U,2),! S LN1=0
19 D KILLADM Q
20ICDS ; ICD Surgery
21 N GMCZ,GMA,D0,DA,DR,DIC,II,IX,SURG,ZI Q:'$D(^DGPT(PTF,"S"))
22 S II=0 F ZI=1:1 S II=$O(^DGPT(PTF,"S",II)) Q:'II S SURG=^DGPT(PTF,"S",II,0),X=$P(SURG,U,1),IX=9999999-X I X>T2&(X<T1) D REGDT4^GMTSU D ICDS1
23 Q
24ICDS1 ; Load Surgery entries into GMS array (inverted)
25 S GMCZ=2 S GMS(IX)=" Surgery "_X F GMA=8:1:12 D SGY
26 Q
27SGY ; Surgery Line
28 N ICDP,ICDI,ICDX
29 S ICDI=+$P(SURG,U,GMA) Q:ICDI'>0
30 S ICDX=$$ICDOP^ICDCODE(+ICDI)
31 S ICDS(80.1,ICDI,.01)=$P(ICDX,"^",2)
32 S ICDS(80.1,ICDI,4)=$P(ICDX,"^",5)
33 I $D(ICDS(80.1,ICDI)) D
34 . S GMS(IX,GMA)=$E($G(ICDS(80.1,ICDI,4)),1,45)_U_$G(ICDS(80.1,ICDI,.01))
35 Q
36 ;
37ENP ; Module For History of PTF Procedures
38 I $D(GMTSNDM),GMTSNDM>0 S CNTR=GMTSNDM
39 E S CNTR=100
40 S T1=GMTSEND,T2=GMTSBEG,GMCZ=0
41 S PTF=0
42 F S PTF=$O(^DGPT("B",DFN,PTF)) Q:PTF="" D ICDP
43 D:$$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU) PRC^A7RHSM
44 I $D(GMP) S O=0 F I=1:1 S O=$O(GMP(O)) Q:O="" Q:'CNTR S CNTR=CNTR-1 S O1=0,LN1=1 F I=1:1 S O1=$O(GMP(O,O1)) Q:O1="" D CKP^GMTSUP Q:$D(GMTSQIT) S:GMTSNPG LN1=1 W:LN1 GMP(O) W ?21,$P(GMP(O,O1),U),?68,$P(GMP(O,O1),U,2),! S LN1=0
45 D KILLADM Q
46 Q
47ICDP ; ICD Procedures
48 N D0,DA,DIC,DR,GMCZ,GTA,II,IX,PRX,ZI Q:'$D(^DGPT(PTF,"P"))
49 S II=0 F ZI=1:1 S II=$O(^DGPT(PTF,"P",II)) Q:'II S PRX=^DGPT(PTF,"P",II,0),X=$P(PRX,U,1),IX=9999999-X I X>T2&(X<T1) D REGDT4^GMTSU D ICDP1
50 Q
51ICDP1 ; Load Procedure entries into GMP array (inverted)
52 S GMCZ=2 S GMP(IX)="Procedure "_X F GTA=5:1:9 D PXGY
53 Q
54PXGY ; Procedure Line
55 N ICDP,ICDI,ICDX
56 S ICDI=+$P(PRX,U,GTA) Q:ICDI'>0
57 S ICDX=$$ICDOP^ICDCODE(+ICDI)
58 S ICDP(80.1,ICDI,.01)=$P(ICDX,"^",2)
59 S ICDP(80.1,ICDI,4)=$P(ICDX,"^",5)
60 I $D(ICDP(80.1,ICDI)) D
61 . S GMP(IX,GTA)=$E($G(ICDP(80.1,ICDI,4)),1,45)_U_$G(ICDP(80.1,ICDI,.01))
62 Q
63 ;
64KILLADM ; Kills Admission variables
65 K CNTR,GMCZ,LN1,IX,X,ZA,N,ICD,ICD0,PTF,GMC,O,O1,GMS,T1,T2,SURG,SURGY,PRX,PRXY,DATE,D1,I,IMT,GMA,GTA,II,ZI,GMP
66 K ICDP,ICDS
67 Q
Note: See TracBrowser for help on using the repository browser.