- GMTSDGP ; SLC/TRS,KER/NDBI - PTF Surgeries/Procedures ;06/25/15 15:48
- ;;2.7;Health Summary;**28,49,60,71,101,111**;Oct 20, 1995;Build 17
- ;
- ; External References
- ; ICR 5699 $$ICDDATA^ICDXCODE
- ; ICR 1372 ^DGPT(
- ; ICR 1372 ^DGPT("B"
- ; ICR 2929 OPC^A7RHSM
- ; ICR 2929 PRC^A7RHSM
- ;
- ENS ; Module For History of PTF Surgery Episodes
- I $D(GMTSNDM),GMTSNDM>0 S CNTR=GMTSNDM
- E S CNTR=100
- S T1=GMTSEND,T2=GMTSBEG,GMCZ=0
- S PTF=0
- F S PTF=$O(^DGPT("B",DFN,PTF)) Q:PTF="" D ICDS
- D:$$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU) OPC^A7RHSM
- 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 ?23,$P(GMS(O,O1),U),?61,$P(GMS(O,O1),U,2),! S LN1=0
- D KILLADM Q
- ICDS ; ICD Surgery
- N GMCZ,GMA,D0,DA,DR,DIC,II,IX,SURG,ZI,GMTSDATE Q:'$D(^DGPT(PTF,"S"))
- S II=0 F ZI=1:1 S II=$O(^DGPT(PTF,"S",II)) Q:'II S SURG=^DGPT(PTF,"S",II,0)_U_$G(^DGPT(PTF,"S",II,1)),X=$P(SURG,U,1),IX=9999999-X I X>T2&(X<T1) D REGDT4^GMTSU D ICDS1
- Q
- ICDS1 ; Load Surgery entries into GMS array (inverted)
- S GMCZ=2 S GMS(IX)=" Surgery "_X F GMA=8:1:32 D SGY
- Q
- SGY ; Surgery Line
- N ICDP,ICDI,ICDX,GMTSDATE,GMTSTEMP,GMTSTAB
- S GMTSDATE=$P(^DGPT(PTF,70),U),GMTSTAB=" "
- S ICDI=+$P(SURG,U,GMA) Q:ICDI'>0
- S ICDX=$$CODESYS^GMTSPXU1(ICDI,80.1)
- I $P($G(ICDX),U)=-1 S GMS(IX,GMA)=$J(" ",38)_$P($G(ICDX),"^",2) Q
- S ICDS(80.1,ICDI,.01)=GMTSTAB_$P(ICDX,U)_"("_$P(ICDX,U,2)_")"
- S GMTSTEMP=$$VLT^ICDEX(80.1,ICDI,$G(GMTSDATE))
- S ICDS(80.1,ICDI,4)=GMTSTEMP
- I $D(ICDS(80.1,ICDI)) D
- . S GMS(IX,GMA)=$G(ICDS(80.1,ICDI,4))_U_$G(ICDS(80.1,ICDI,.01))
- Q
- ;
- ENP ; Module For History of PTF Procedures
- I $D(GMTSNDM),GMTSNDM>0 S CNTR=GMTSNDM
- E S CNTR=100
- S T1=GMTSEND,T2=GMTSBEG,GMCZ=0
- S PTF=0
- F S PTF=$O(^DGPT("B",DFN,PTF)) Q:PTF="" D ICDP
- D:$$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU) PRC^A7RHSM
- 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 ?23,$P(GMP(O,O1),U),?61,$P(GMP(O,O1),U,2),! S LN1=0
- D KILLADM Q
- Q
- ICDP ; ICD Procedures
- N D0,DA,DIC,DR,GMCZ,GTA,II,IX,PRX,ZI Q:'$D(^DGPT(PTF,"P"))
- S II=0 F ZI=1:1 S II=$O(^DGPT(PTF,"P",II)) Q:'II S PRX=^DGPT(PTF,"P",II,0)_U_$G(^DGPT(PTF,"P",II,1)),X=$P(PRX,U,1),IX=9999999-X I X>T2&(X<T1) D REGDT4^GMTSU D ICDP1
- Q
- ICDP1 ; Load Procedure entries into GMP array (inverted)
- S GMCZ=2 S GMP(IX)="Procedure "_X F GTA=5:1:29 D PXGY
- Q
- PXGY ; Procedure Line
- N ICDP,ICDI,ICDX,GMTSDATE,GMTSTEMP,GMTSTAB
- S GMTSDATE=$P(^DGPT(PTF,70),U),GMTSTAB=" "
- S ICDI=+$P(PRX,U,GTA) Q:ICDI'>0
- S ICDX=$$CODESYS^GMTSPXU1(ICDI,80.1)
- I $P($G(ICDX),U)=-1 S GMP(IX,GTA)=$J(" ",38)_$P($G(ICDX),"^",2) Q
- S ICDP(80.1,ICDI,.01)=GMTSTAB_$P(ICDX,U)_"("_$P(ICDX,U,2)_")"
- S GMTSTEMP=$$VLT^ICDEX(80.1,ICDI,$G(GMTSDATE))
- S ICDP(80.1,ICDI,4)=GMTSTEMP
- I $D(ICDP(80.1,ICDI)) D
- . S GMP(IX,GTA)=$G(ICDP(80.1,ICDI,4))_U_$G(ICDP(80.1,ICDI,.01))
- Q
- ;
- KILLADM ; Kills Admission variables
- 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
- K ICDP,ICDS
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSDGP 3243 printed Mar 13, 2025@21:02:05 Page 2
- GMTSDGP ; SLC/TRS,KER/NDBI - PTF Surgeries/Procedures ;06/25/15 15:48
- +1 ;;2.7;Health Summary;**28,49,60,71,101,111**;Oct 20, 1995;Build 17
- +2 ;
- +3 ; External References
- +4 ; ICR 5699 $$ICDDATA^ICDXCODE
- +5 ; ICR 1372 ^DGPT(
- +6 ; ICR 1372 ^DGPT("B"
- +7 ; ICR 2929 OPC^A7RHSM
- +8 ; ICR 2929 PRC^A7RHSM
- +9 ;
- ENS ; Module For History of PTF Surgery Episodes
- +1 IF $DATA(GMTSNDM)
- IF GMTSNDM>0
- SET CNTR=GMTSNDM
- +2 IF '$TEST
- SET CNTR=100
- +3 SET T1=GMTSEND
- SET T2=GMTSBEG
- SET GMCZ=0
- +4 SET PTF=0
- +5 FOR
- SET PTF=$ORDER(^DGPT("B",DFN,PTF))
- if PTF=""
- QUIT
- DO ICDS
- +6 if $$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU)
- DO OPC^A7RHSM
- +7 IF $DATA(GMS)
- SET O=0
- FOR I=1:1
- SET O=$ORDER(GMS(O))
- if O=""
- QUIT
- if 'CNTR
- QUIT
- SET CNTR=CNTR-1
- SET O1=0
- SET LN1=1
- FOR I=1:1
- SET O1=$ORDER(GMS(O,O1))
- if O1=""
- QUIT
- DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- if GMTSNPG
- SET LN1=1
- if LN1
- WRITE GMS(O)
- WRITE ?23,$PIECE(GMS(O,O1),U),?61,$PIECE(GMS(O,O1),U,2),!
- SET LN1=0
- +8 DO KILLADM
- QUIT
- ICDS ; ICD Surgery
- +1 NEW GMCZ,GMA,D0,DA,DR,DIC,II,IX,SURG,ZI,GMTSDATE
- if '$DATA(^DGPT(PTF,"S"))
- QUIT
- +2 SET II=0
- FOR ZI=1:1
- SET II=$ORDER(^DGPT(PTF,"S",II))
- if 'II
- QUIT
- SET SURG=^DGPT(PTF,"S",II,0)_U_$GET(^DGPT(PTF,"S",II,1))
- SET X=$PIECE(SURG,U,1)
- SET IX=9999999-X
- IF X>T2&(X<T1)
- DO REGDT4^GMTSU
- DO ICDS1
- +3 QUIT
- ICDS1 ; Load Surgery entries into GMS array (inverted)
- +1 SET GMCZ=2
- SET GMS(IX)=" Surgery "_X
- FOR GMA=8:1:32
- DO SGY
- +2 QUIT
- SGY ; Surgery Line
- +1 NEW ICDP,ICDI,ICDX,GMTSDATE,GMTSTEMP,GMTSTAB
- +2 SET GMTSDATE=$PIECE(^DGPT(PTF,70),U)
- SET GMTSTAB=" "
- +3 SET ICDI=+$PIECE(SURG,U,GMA)
- if ICDI'>0
- QUIT
- +4 SET ICDX=$$CODESYS^GMTSPXU1(ICDI,80.1)
- +5 IF $PIECE($GET(ICDX),U)=-1
- SET GMS(IX,GMA)=$JUSTIFY(" ",38)_$PIECE($GET(ICDX),"^",2)
- QUIT
- +6 SET ICDS(80.1,ICDI,.01)=GMTSTAB_$PIECE(ICDX,U)_"("_$PIECE(ICDX,U,2)_")"
- +7 SET GMTSTEMP=$$VLT^ICDEX(80.1,ICDI,$GET(GMTSDATE))
- +8 SET ICDS(80.1,ICDI,4)=GMTSTEMP
- +9 IF $DATA(ICDS(80.1,ICDI))
- Begin DoDot:1
- +10 SET GMS(IX,GMA)=$GET(ICDS(80.1,ICDI,4))_U_$GET(ICDS(80.1,ICDI,.01))
- End DoDot:1
- +11 QUIT
- +12 ;
- ENP ; Module For History of PTF Procedures
- +1 IF $DATA(GMTSNDM)
- IF GMTSNDM>0
- SET CNTR=GMTSNDM
- +2 IF '$TEST
- SET CNTR=100
- +3 SET T1=GMTSEND
- SET T2=GMTSBEG
- SET GMCZ=0
- +4 SET PTF=0
- +5 FOR
- SET PTF=$ORDER(^DGPT("B",DFN,PTF))
- if PTF=""
- QUIT
- DO ICDP
- +6 if $$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU)
- DO PRC^A7RHSM
- +7 IF $DATA(GMP)
- SET O=0
- FOR I=1:1
- SET O=$ORDER(GMP(O))
- if O=""
- QUIT
- if 'CNTR
- QUIT
- SET CNTR=CNTR-1
- SET O1=0
- SET LN1=1
- FOR I=1:1
- SET O1=$ORDER(GMP(O,O1))
- if O1=""
- QUIT
- DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- if GMTSNPG
- SET LN1=1
- if LN1
- WRITE GMP(O)
- WRITE ?23,$PIECE(GMP(O,O1),U),?61,$PIECE(GMP(O,O1),U,2),!
- SET LN1=0
- +8 DO KILLADM
- QUIT
- +9 QUIT
- ICDP ; ICD Procedures
- +1 NEW D0,DA,DIC,DR,GMCZ,GTA,II,IX,PRX,ZI
- if '$DATA(^DGPT(PTF,"P"))
- QUIT
- +2 SET II=0
- FOR ZI=1:1
- SET II=$ORDER(^DGPT(PTF,"P",II))
- if 'II
- QUIT
- SET PRX=^DGPT(PTF,"P",II,0)_U_$GET(^DGPT(PTF,"P",II,1))
- SET X=$PIECE(PRX,U,1)
- SET IX=9999999-X
- IF X>T2&(X<T1)
- DO REGDT4^GMTSU
- DO ICDP1
- +3 QUIT
- ICDP1 ; Load Procedure entries into GMP array (inverted)
- +1 SET GMCZ=2
- SET GMP(IX)="Procedure "_X
- FOR GTA=5:1:29
- DO PXGY
- +2 QUIT
- PXGY ; Procedure Line
- +1 NEW ICDP,ICDI,ICDX,GMTSDATE,GMTSTEMP,GMTSTAB
- +2 SET GMTSDATE=$PIECE(^DGPT(PTF,70),U)
- SET GMTSTAB=" "
- +3 SET ICDI=+$PIECE(PRX,U,GTA)
- if ICDI'>0
- QUIT
- +4 SET ICDX=$$CODESYS^GMTSPXU1(ICDI,80.1)
- +5 IF $PIECE($GET(ICDX),U)=-1
- SET GMP(IX,GTA)=$JUSTIFY(" ",38)_$PIECE($GET(ICDX),"^",2)
- QUIT
- +6 SET ICDP(80.1,ICDI,.01)=GMTSTAB_$PIECE(ICDX,U)_"("_$PIECE(ICDX,U,2)_")"
- +7 SET GMTSTEMP=$$VLT^ICDEX(80.1,ICDI,$GET(GMTSDATE))
- +8 SET ICDP(80.1,ICDI,4)=GMTSTEMP
- +9 IF $DATA(ICDP(80.1,ICDI))
- Begin DoDot:1
- +10 SET GMP(IX,GTA)=$GET(ICDP(80.1,ICDI,4))_U_$GET(ICDP(80.1,ICDI,.01))
- End DoDot:1
- +11 QUIT
- +12 ;
- KILLADM ; Kills Admission variables
- +1 KILL 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
- +2 KILL ICDP,ICDS
- +3 QUIT
