GMTSDGC2 ; SLC/SBW,KER - Extended ADT Hist (cont) ; 03/24/2004
;;2.7;Health Summary;**28,49,71**;Oct 20, 1995
;
; External References
; DBIA 1372 ^DGPT(
; DBIA 3390 $$ICDOP^ICDCODE
;
ICDP(DFN,PTF) ; Module For History of PTF Procedures
Q:'$D(^DGPT(PTF,"P"))
N II,PRX,X,IX,GMP,GTA,O,O1,LN1
S II=0
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
. S GMP(IX)="Procedure "_X F GTA=5:1:9 D
. . N ICDP,ICDI,ICDX Q:$P(PRX,U,GTA)=""
. . S ICDI=+($P(PRX,U,GTA)) Q:+ICDI'>0
. . S ICDX=$$ICDOP^ICDCODE(+ICDI)
. . S ICDP(80.1,ICDI,.01)=$P(ICDX,"^",2)
. . S ICDP(80.1,ICDI,4)=$P(ICDX,"^",5)
. . I $D(ICDP(80.1,ICDI)) D
. . . S GMP(IX,GTA)=$E(ICDP(80.1,ICDI,4),1,45)_U_ICDP(80.1,ICDI,.01)
I $D(GMP) S O=0 F S O=$O(GMP(O)) Q:O="" D
. S O1=0,LN1=1
. 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
Q
ICDS(DFN,PTF) ; Module for history of PTF surgery episodes
Q:'$D(^DGPT(PTF,"S"))
N II,SURG,X,IX,GMS,GMA,O,O1,LN1
S II=0
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
. ; Load Surgery entries into GMS array in inverted sequence
. S GMS(IX)=" Surgery "_X F GMA=8:1:12 D
. . ; Surgery Line
. . N ICDS,ICDI,ICDX
. . S ICDI=+($P(SURG,U,GMA)) Q:+ICDI'>0
. . S ICDX=$$ICDOP^ICDCODE(+ICDI)
. . S ICDS(80.1,ICDI,.01)=$P(ICDX,"^",2)
. . S ICDS(80.1,ICDI,4)=$P(ICDX,"^",5)
. . I $D(ICDS(80.1,ICDI)) S GMS(IX,GMA)=$E(ICDS(80.1,ICDI,4),1,45)_U_ICDS(80.1,ICDI,.01)
I $D(GMS) S O=0 F S O=$O(GMS(O)) Q:O="" D
. S O1=0,LN1=1
. 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
Q
GMTSDGC2 ; SLC/SBW,KER - Extended ADT Hist (cont) ; 03/24/2004
+1 ;;2.7;Health Summary;**28,49,71**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 1372 ^DGPT(
+5 ; DBIA 3390 $$ICDOP^ICDCODE
+6 ;
ICDP(DFN,PTF) ; Module For History of PTF Procedures
+1 IF '$DATA(^DGPT(PTF,"P"))
QUIT
+2 NEW II,PRX,X,IX,GMP,GTA,O,O1,LN1
+3 SET II=0
+4 FOR
SET II=$ORDER(^DGPT(PTF,"P",II))
IF 'II
QUIT
SET PRX=^DGPT(PTF,"P",II,0)
SET X=$PIECE(PRX,U,1)
SET IX=9999999-X
DO REGDT4^GMTSU
Begin DoDot:1
+5 SET GMP(IX)="Procedure "_X
FOR GTA=5:1:9
Begin DoDot:2
+6 NEW ICDP,ICDI,ICDX
IF $PIECE(PRX,U,GTA)=""
QUIT
+7 SET ICDI=+($PIECE(PRX,U,GTA))
IF +ICDI'>0
QUIT
+8 SET ICDX=$$ICDOP^ICDCODE(+ICDI)
+9 SET ICDP(80.1,ICDI,.01)=$PIECE(ICDX,"^",2)
+10 SET ICDP(80.1,ICDI,4)=$PIECE(ICDX,"^",5)
+11 IF $DATA(ICDP(80.1,ICDI))
Begin DoDot:3
+12 SET GMP(IX,GTA)=$EXTRACT(ICDP(80.1,ICDI,4),1,45)_U_ICDP(80.1,ICDI,.01)
End DoDot:3
End DoDot:2
End DoDot:1
+13 IF $DATA(GMP)
SET O=0
FOR
SET O=$ORDER(GMP(O))
IF O=""
QUIT
Begin DoDot:1
+14 SET O1=0
SET LN1=1
+15 FOR
SET O1=$ORDER(GMP(O,O1))
IF O1=""
QUIT
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
IF GMTSNPG
SET LN1=1
IF LN1
WRITE ?2,GMP(O)
WRITE ?23,$PIECE(GMP(O,O1),U),?69,$PIECE(GMP(O,O1),U,2),!
SET LN1=0
End DoDot:1
+16 QUIT
ICDS(DFN,PTF) ; Module for history of PTF surgery episodes
+1 IF '$DATA(^DGPT(PTF,"S"))
QUIT
+2 NEW II,SURG,X,IX,GMS,GMA,O,O1,LN1
+3 SET II=0
+4 FOR
SET II=$ORDER(^DGPT(PTF,"S",II))
IF 'II
QUIT
SET SURG=^DGPT(PTF,"S",II,0)
SET X=$PIECE(SURG,U,1)
SET IX=9999999-X
DO REGDT4^GMTSU
Begin DoDot:1
+5 ; Load Surgery entries into GMS array in inverted sequence
+6 SET GMS(IX)=" Surgery "_X
FOR GMA=8:1:12
Begin DoDot:2
+7 ; Surgery Line
+8 NEW ICDS,ICDI,ICDX
+9 SET ICDI=+($PIECE(SURG,U,GMA))
IF +ICDI'>0
QUIT
+10 SET ICDX=$$ICDOP^ICDCODE(+ICDI)
+11 SET ICDS(80.1,ICDI,.01)=$PIECE(ICDX,"^",2)
+12 SET ICDS(80.1,ICDI,4)=$PIECE(ICDX,"^",5)
+13 IF $DATA(ICDS(80.1,ICDI))
SET GMS(IX,GMA)=$EXTRACT(ICDS(80.1,ICDI,4),1,45)_U_ICDS(80.1,ICDI,.01)
End DoDot:2
End DoDot:1
+14 IF $DATA(GMS)
SET O=0
FOR
SET O=$ORDER(GMS(O))
IF O=""
QUIT
Begin DoDot:1
+15 SET O1=0
SET LN1=1
+16 FOR
SET O1=$ORDER(GMS(O,O1))
IF O1=""
QUIT
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
IF GMTSNPG
SET LN1=1
IF LN1
WRITE ?2,GMS(O)
WRITE ?23,$PIECE(GMS(O,O1),U),?69,$PIECE(GMS(O,O1),U,2),!
SET LN1=0
End DoDot:1
+17 QUIT
