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

GMTSLRCP.m

Go to the documentation of this file. 
  1. GMTSLRCP ; SLC/JER,KER - Cytopathology Comp Dvr ; 09/21/2001
  1.  ;;2.7;Health Summary;**28,47**;Oct 20, 1995
  1.  ;
  1.  ; External References
  1.  ;    DBIA   525  ^LR( all fields
  1.  ;    DBIA 10035  ^DPT( field 63 Read w/Fileman
  1.  ;    DBIA  2056  $$GET1^DIQ (file 2)
  1.  ;                   
  1. MAIN ; Cytopathology
  1.  N GMI,IX,IX0,IX1,MAX,LRDFN
  1.  S LRDFN=+($$GET1^DIQ(2,(+($G(DFN))_","),63,"I")) Q:+LRDFN=0  Q:'$D(^LR(LRDFN))
  1.  S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:999) D ^GMTSLRPE
  1.  Q:'$D(^TMP("LRCY",$J))  S IX=""
  1.  F GMI=1:1:MAX S IX=$O(^TMP("LRCY",$J,IX)) Q:IX=""  D  Q:$D(GMTSQIT)
  1.  . D:GMI>1 CKP^GMTSUP Q:$D(GMTSQIT)  W:GMI>1&'GMTSNPG ! S IX0=""
  1.  . F  S IX0=$O(^TMP("LRCY",$J,IX,IX0)) Q:IX0=""  D  Q:$D(GMTSQIT)
  1.  . . D TRVRS
  1.  K ^TMP("LRCY",$J)
  1.  Q
  1. TRVRS ; Traverses/Interprets ^TMP("LRCY",$J,
  1.  N GMS,SPEC
  1.  I IX0=0 D CKP^GMTSUP Q:$D(GMTSQIT)  W ?8,"Collected:",?19,$P(^TMP("LRCY",$J,IX,IX0),U),?31,"Acc:",?36,$P(^TMP("LRCY",$J,IX,IX0),U,2),! Q
  1.  I IX0=1 D CKP^GMTSUP Q:$D(GMTSQIT)  W ?9,"Specimen:" S GMS=0 F  S GMS=$O(^TMP("LRCY",$J,IX,IX0,GMS)) Q:GMS'>0  D CKP^GMTSUP Q:$D(GMTSQIT)  W ?19,^TMP("LRCY",$J,IX,IX0,GMS),!
  1.  I IX0=1,($P(^TMP("LRCY",$J,IX,IX0),U,2)'>0) D CKP^GMTSUP Q:$D(GMTSQIT)  W ?18,"** REPORT NOT YET RELEASED **",!
  1.  Q:IX0=1  D @$E(IX0,1,2)
  1.  Q
  1. AH ; Writes clinical history
  1.  N GMTSH,GMTSHL,GMTSHLI
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)  W !,"Brief Clinical Hx:",!
  1.  S GMTSH=0
  1.  F  S GMTSH=$O(^TMP("LRCY",$J,IX,IX0,GMTSH)) Q:+GMTSH'>0  S GMTSHL=^(GMTSH) D
  1.  .I $L(GMTSHL)>78 S GMTSHL=$$WRAP^GMTSORC(GMTSHL,78)
  1.  .D CKP^GMTSUP Q:$D(GMTSQIT)  W $P(GMTSHL,"|"),! D
  1.  ..F GMTSHLI=2:1:$L(GMTSHL,"|") D CKP^GMTSUP Q:$D(GMTSQIT)  W:$P(GMTSHL,"|",GMTSHLI)]"" $P(GMTSHL,"|",GMTSHLI),!
  1.  Q
  1. G ; Writes Gross Description
  1.  N GMTSG,GMTSGL,GMTSGLI
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)  W !,"Gross Description:",!
  1.  S GMTSG=0
  1.  F  S GMTSG=$O(^TMP("LRCY",$J,IX,IX0,GMTSG)) Q:GMTSG'>0  S GMTSGL=^(GMTSG) D
  1.  .I $L(GMTSGL)>78 S GMTSGL=$$WRAP^GMTSORC(GMTSGL,78)
  1.  .D CKP^GMTSUP Q:$D(GMTSQIT)  W $P(GMTSGL,"|"),! D
  1.  ..F GMTSGLI=2:1:$L(GMTSGL,"|") D CKP^GMTSUP Q:$D(GMTSQIT)  W:$P(GMTSGL,"|",GMTSGLI)]"" $P(GMTSGL,"|",GMTSGLI),!
  1.  Q
  1. MI ; Writes Microscopic exam/diagnosis field
  1.  N GMTSM,GMTSML,GMTSMLI
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)  W !,"Microscopic exam:",!
  1.  S GMTSM=0
  1.  F  S GMTSM=$O(^TMP("LRCY",$J,IX,IX0,GMTSM)) Q:GMTSM'>0  S GMTSML=^(GMTSM) D
  1.  . I $L(GMTSML)>78 S GMTSML=$$WRAP^GMTSORC(GMTSML,78)
  1.  . D CKP^GMTSUP Q:$D(GMTSQIT)  W $P(GMTSML,"|"),! D
  1.  . . F GMTSMLI=2:1:$L(GMTSML,"|") D CKP^GMTSUP Q:$D(GMTSQIT)  W:$P(GMTSML,"|",GMTSMLI)]"" $P(GMTSML,"|",GMTSMLI),!
  1.  Q
  1. SR ; Writes Supplementary Reports
  1.  N GMTSLINE,GMTSL,GMTSR,SRDATE,X S IX1=0
  1.  F  S IX1=$O(^TMP("LRCY",$J,IX,IX0,IX1)) Q:IX1'>0  D  Q:$D(GMTSQIT)
  1.  . D CKP^GMTSUP Q:$D(GMTSQIT)  S SRDATE=^TMP("LRCY",$J,IX,IX0,IX1,0)
  1.  . S X=SRDATE D REGDTM4^GMTSU W !,"Supplementary Rpt: ",X,!
  1.  . S GMTSR=0
  1.  . F  S GMTSR=$O(^TMP("LRCY",$J,IX,IX0,IX1,GMTSR)) Q:GMTSR'>0  D  Q:$D(GMTSQIT)
  1.  . . S GMTSLINE=^TMP("LRCY",$J,IX,IX0,IX1,GMTSR) I $L(GMTSLINE)>78 S GMTSLINE=$$WRAP^GMTSORC(GMTSLINE,78)
  1.  . . D CKP^GMTSUP Q:$D(GMTSQIT)  W $P(GMTSLINE,"|"),! D
  1.  . . . F GMTSL=2:1:$L(GMTSLINE,"|") D  Q:$D(GMTSQIT)
  1.  . . . . D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  . . . . W:$P(GMTSLINE,"|",GMTSL)]"" $P(GMTSLINE,"|",GMTSL),!
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)  W !
  1.  Q
  1. ND ; Writes Diagnosis field
  1.  N GMTSD,GMTSDL,GMTSDLI
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)  W !," Cytopathology Dx:",!
  1.  S GMTSD=0
  1.  F  S GMTSD=$O(^TMP("LRCY",$J,IX,IX0,GMTSD)) Q:GMTSD'>0  D  Q:$D(GMTSQIT)
  1.  . S GMTSDL=^(GMTSD)
  1.  . I $L(GMTSDL)>78 S GMTSDL=$$WRAP^GMTSORC(GMTSDL,78)
  1.  . D CKP^GMTSUP Q:$D(GMTSQIT)  W $P(GMTSDL,"|"),!
  1.  . F GMTSDLI=2:1:$L(GMTSDL,"|") D  Q:$D(GMTSQIT)
  1.  . . D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  . . W:$P(GMTSDL,"|",GMTSDLI)]"" $P(GMTSDL,"|",GMTSDLI),!
  1.  Q
  1. OT ; Traverses/Interprets Organ/Tissue Subarray
  1.  N OT S OT=0 D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  W ?7,"Topography:",?19,^TMP("LRCY",$J,IX,IX0,OT),!
  1.  F  S OT=$O(^TMP("LRCY",$J,IX,IX0,OT)) Q:OT=""  D @$E(OT,1)
  1.  Q
  1. D ; Writes Disease Field
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  W:OT="D1"!(GMTSNPG) ?9,"Diseases:"
  1.  W ?21,^TMP("LRCY",$J,IX,IX0,OT),!
  1.  Q
  1. M ; Writes Morphology Field
  1.  N GME
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  W ?7,"Morphology:",?21,$P(^TMP("LRCY",$J,IX,IX0,OT),U),!
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  S GME="" F  S GME=$O(^TMP("LRCY",$J,IX,IX0,OT,GME)) Q:GME=""  D  Q:$D(GMTSQIT)
  1.  . D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  . W:GME[1!(GMTSNPG) ?9,"Etiology:"
  1.  . W ?23,^TMP("LRCY",$J,IX,IX0,OT,GME),!
  1.  Q
  1. P ; Writes Procedure Field
  1.  N GMTSJ,GMK S GMTSJ=$P(^TMP("LRCY",$J,IX,IX0,OT),U)
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  I $L(GMTSJ)>56 S GMTSJ=$$WRAP^GMTSORC(GMTSJ,56)
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)  W:((OT="P1")!(GMTSNPG)) ?7,"Procedures:"
  1.  W ?21,$P(GMTSJ,"|"),!
  1.  F GMK=2:1:$L(GMTSJ,"|") D  Q:$D(GMTSQIT)
  1.  . D CKP^GMTSUP Q:$D(GMTSQIT)
  1.  . W:$P(GMTSJ,"|",GMK)]"" ?23,$P(GMTSJ,"|",GMK),!
  1.  K ^UTILITY($J,"W")
  1.  Q
  1. XI ; Writes ICD diagnoses
  1.  N GMTSDX D CKP^GMTSUP Q:$D(GMTSQIT)  W "  ICD-9 Diagnoses:" S GMTSDX=0
  1.  F  S GMTSDX=$O(^TMP("LRCY",$J,IX,IX0,GMTSDX)) Q:GMTSDX=""  D  Q:$D(GMTSQIT)
  1.  . D CKP^GMTSUP Q:$D(GMTSQIT)  W:GMTSNPG ?2,"ICD-9 Diagnoses:"
  1.  . W ?19,$P(^TMP("LRCY",$J,IX,IX0,GMTSDX),U)
  1.  . W ?28,$P(^TMP("LRCY",$J,IX,IX0,GMTSDX),U,2),!
  1.  Q