Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMTSDGP

GMTSDGP.m

Go to the documentation of this file.
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