| [613] | 1 | GMTSDGP ; 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 | ;
|
|---|
| 11 | ENS ; 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
|
|---|
| 20 | ICDS ; 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
|
|---|
| 24 | ICDS1 ; 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
|
|---|
| 27 | SGY ; 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 | ;
|
|---|
| 37 | ENP ; 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
|
|---|
| 47 | ICDP ; 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
|
|---|
| 51 | ICDP1 ; 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
|
|---|
| 54 | PXGY ; 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 | ;
|
|---|
| 64 | KILLADM ; 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
|
|---|
