- GMTSLRPE ; SLC/JER,KER - Cytopathology Extract Routine ; 08/27/2002
- ;;2.7;Health Summary;**3,28,37,56**;Oct 20, 1995
- ;
- ; External References
- ; DBIA 525 ^LR(
- ; DBIA 529 ^LAB(61.1 0;1
- ; DBIA 526 ^LAB(61.2 0;1
- ; DBIA 10133 ^LAB(61.4 0;1
- ; DBIA 10134 ^LAB(61.5 0;1
- ; DBIA 2056 $$GET1^DIQ (file #61.1, 61.2, 61.4, and 61.5)
- ;
- XTRCT ; Extract
- N IX0,IX K ^TMP("LRCY",$J) S IX=GMTS1
- F IX0=1:0:MAX S IX=$O(^LR(LRDFN,"CY",IX)) Q:IX'>0!(IX>GMTS2) D CYSET
- Q
- CYSET ; Sets ^TMP("LRCY",$J, with appropriate data elements
- N ACC,CDT,D1,D2,D3,DA,DIC,DIQ,DR,DX,ICD,OT,SR,RELEASE,SITE,SN,X,YR
- S CDT=$P(^LR(LRDFN,"CY",IX,0),U),ACC=$P(^(0),U,6),RELEASE=$P(^(0),U,11)
- I $D(ACC) S IX0=IX0+1
- S X=CDT D REGDT4^GMTSU S CDT=X K X
- S ^TMP("LRCY",$J,IX,0)=CDT_U_ACC
- I $D(^LR(LRDFN,"CY",IX,.1)) S ^TMP("LRCY",$J,IX,1)="Site/Specimen"_U_RELEASE
- Q:'RELEASE
- S SN=0 F S SN=$O(^LR(LRDFN,"CY",IX,.1,SN)) Q:SN'>0 S ^TMP("LRCY",$J,IX,1,SN)=$P(^LR(LRDFN,"CY",IX,.1,SN,0),U)
- S OT=0 F S OT=$O(^LR(LRDFN,"CY",IX,.2,OT)) Q:+OT'>0 S ^TMP("LRCY",$J,IX,"AH",OT)=$G(^LR(LRDFN,"CY",IX,.2,OT,0))
- S OT=0 F S OT=$O(^LR(LRDFN,"CY",IX,1,OT)) Q:OT'>0 S ^TMP("LRCY",$J,IX,"G",OT)=^LR(LRDFN,"CY",IX,1,OT,0)
- S OT=0 F S OT=$O(^LR(LRDFN,"CY",IX,1.1,OT)) Q:OT'>0 S ^TMP("LRCY",$J,IX,"MI",OT)=^LR(LRDFN,"CY",IX,1.1,OT,0)
- S OT=0 F S OT=$O(^LR(LRDFN,"CY",IX,1.2,OT)) Q:OT'>0 D
- . Q:+$P($G(^LR(LRDFN,"CY",IX,1.2,OT,0)),U,2)'>0
- . S ^TMP("LRCY",$J,IX,"SR",OT,0)=$P($G(^LR(LRDFN,"CY",IX,1.2,OT,0)),U)
- . S SR=0 F S SR=$O(^LR(LRDFN,"CY",IX,1.2,OT,1,SR)) Q:SR'>0 D
- . . S ^TMP("LRCY",$J,IX,"SR",OT,SR)=$P($G(^LR(LRDFN,"CY",IX,1.2,OT,1,SR,0)),U)
- S OT=0 F S OT=$O(^LR(LRDFN,"CY",IX,1.4,OT)) Q:+OT'>0 S ^TMP("LRCY",$J,IX,"NDX",OT)=$P($G(^LR(LRDFN,"CY",IX,1.4,OT,0)),U)
- Q
- D ; Get Disease Field data
- N GMI,GMD,DIS S GMD=0 F S GMD=$O(^LR(LRDFN,"CY",IX,2,OT,1,GMD)) Q:GMD="" D
- . S GMI=+^LR(LRDFN,"CY",IX,2,OT,1,GMD,0)
- . S ^TMP("LRCY",$J,IX,"OT"_OT,"D"_GMD)=$$GET1^DIQ(61.4,GMI,.01,"I")
- Q
- M ; Get Morphology Field data
- N GMI,GMM,MORPH S GMM=0 F S GMM=$O(^LR(LRDFN,"CY",IX,2,OT,2,GMM)) Q:GMM="" D
- . S GMI=+^LR(LRDFN,"CY",IX,2,OT,1,GMD,0)
- . S ^TMP("LRCY",$J,IX,"OT"_OT,"M"_GMM)=$$GET1^DIQ(61.1,GMI,.01,"I")
- . D E
- Q
- E ; Get Etiology Field data
- N GMI,GME,ETIOL S GME=0 F S GME=$O(^LR(LRDFN,"CY",IX,2,OT,2,GMM,1,GME)) Q:GME'>0 D
- . S GMI=+^LR(LRDFN,"CY",IX,2,OT,2,GMM,1,GME,0)
- . S ^TMP("LRCY",$J,IX,"OT"_OT,"M"_GMM,"E"_GME)=$$GET1^DIQ(61.2,GMI,.01,"I")
- Q
- P ; Get Procedure Field data
- N GMI,GMP,PROC S GMP=0 F S GMP=$O(^LR(LRDFN,"CY",IX,2,OT,4,GMP)) Q:GMP="" D
- . S GMI=+^LR(LRDFN,"CY",IX,2,OT,4,GMP,0)
- . S ^TMP("LRCY",$J,IX,"OT"_OT,"P"_GMP)=$$GET1^DIQ(61.5,GMI,.01,"I")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSLRPE 2782 printed Jan 18, 2025@02:59:07 Page 2
- GMTSLRPE ; SLC/JER,KER - Cytopathology Extract Routine ; 08/27/2002
- +1 ;;2.7;Health Summary;**3,28,37,56**;Oct 20, 1995
- +2 ;
- +3 ; External References
- +4 ; DBIA 525 ^LR(
- +5 ; DBIA 529 ^LAB(61.1 0;1
- +6 ; DBIA 526 ^LAB(61.2 0;1
- +7 ; DBIA 10133 ^LAB(61.4 0;1
- +8 ; DBIA 10134 ^LAB(61.5 0;1
- +9 ; DBIA 2056 $$GET1^DIQ (file #61.1, 61.2, 61.4, and 61.5)
- +10 ;
- XTRCT ; Extract
- +1 NEW IX0,IX
- KILL ^TMP("LRCY",$JOB)
- SET IX=GMTS1
- +2 FOR IX0=1:0:MAX
- SET IX=$ORDER(^LR(LRDFN,"CY",IX))
- if IX'>0!(IX>GMTS2)
- QUIT
- DO CYSET
- +3 QUIT
- CYSET ; Sets ^TMP("LRCY",$J, with appropriate data elements
- +1 NEW ACC,CDT,D1,D2,D3,DA,DIC,DIQ,DR,DX,ICD,OT,SR,RELEASE,SITE,SN,X,YR
- +2 SET CDT=$PIECE(^LR(LRDFN,"CY",IX,0),U)
- SET ACC=$PIECE(^(0),U,6)
- SET RELEASE=$PIECE(^(0),U,11)
- +3 IF $DATA(ACC)
- SET IX0=IX0+1
- +4 SET X=CDT
- DO REGDT4^GMTSU
- SET CDT=X
- KILL X
- +5 SET ^TMP("LRCY",$JOB,IX,0)=CDT_U_ACC
- +6 IF $DATA(^LR(LRDFN,"CY",IX,.1))
- SET ^TMP("LRCY",$JOB,IX,1)="Site/Specimen"_U_RELEASE
- +7 if 'RELEASE
- QUIT
- +8 SET SN=0
- FOR
- SET SN=$ORDER(^LR(LRDFN,"CY",IX,.1,SN))
- if SN'>0
- QUIT
- SET ^TMP("LRCY",$JOB,IX,1,SN)=$PIECE(^LR(LRDFN,"CY",IX,.1,SN,0),U)
- +9 SET OT=0
- FOR
- SET OT=$ORDER(^LR(LRDFN,"CY",IX,.2,OT))
- if +OT'>0
- QUIT
- SET ^TMP("LRCY",$JOB,IX,"AH",OT)=$GET(^LR(LRDFN,"CY",IX,.2,OT,0))
- +10 SET OT=0
- FOR
- SET OT=$ORDER(^LR(LRDFN,"CY",IX,1,OT))
- if OT'>0
- QUIT
- SET ^TMP("LRCY",$JOB,IX,"G",OT)=^LR(LRDFN,"CY",IX,1,OT,0)
- +11 SET OT=0
- FOR
- SET OT=$ORDER(^LR(LRDFN,"CY",IX,1.1,OT))
- if OT'>0
- QUIT
- SET ^TMP("LRCY",$JOB,IX,"MI",OT)=^LR(LRDFN,"CY",IX,1.1,OT,0)
- +12 SET OT=0
- FOR
- SET OT=$ORDER(^LR(LRDFN,"CY",IX,1.2,OT))
- if OT'>0
- QUIT
- Begin DoDot:1
- +13 if +$PIECE($GET(^LR(LRDFN,"CY",IX,1.2,OT,0)),U,2)'>0
- QUIT
- +14 SET ^TMP("LRCY",$JOB,IX,"SR",OT,0)=$PIECE($GET(^LR(LRDFN,"CY",IX,1.2,OT,0)),U)
- +15 SET SR=0
- FOR
- SET SR=$ORDER(^LR(LRDFN,"CY",IX,1.2,OT,1,SR))
- if SR'>0
- QUIT
- Begin DoDot:2
- +16 SET ^TMP("LRCY",$JOB,IX,"SR",OT,SR)=$PIECE($GET(^LR(LRDFN,"CY",IX,1.2,OT,1,SR,0)),U)
- End DoDot:2
- End DoDot:1
- +17 SET OT=0
- FOR
- SET OT=$ORDER(^LR(LRDFN,"CY",IX,1.4,OT))
- if +OT'>0
- QUIT
- SET ^TMP("LRCY",$JOB,IX,"NDX",OT)=$PIECE($GET(^LR(LRDFN,"CY",IX,1.4,OT,0)),U)
- +18 QUIT
- D ; Get Disease Field data
- +1 NEW GMI,GMD,DIS
- SET GMD=0
- FOR
- SET GMD=$ORDER(^LR(LRDFN,"CY",IX,2,OT,1,GMD))
- if GMD=""
- QUIT
- Begin DoDot:1
- +2 SET GMI=+^LR(LRDFN,"CY",IX,2,OT,1,GMD,0)
- +3 SET ^TMP("LRCY",$JOB,IX,"OT"_OT,"D"_GMD)=$$GET1^DIQ(61.4,GMI,.01,"I")
- End DoDot:1
- +4 QUIT
- M ; Get Morphology Field data
- +1 NEW GMI,GMM,MORPH
- SET GMM=0
- FOR
- SET GMM=$ORDER(^LR(LRDFN,"CY",IX,2,OT,2,GMM))
- if GMM=""
- QUIT
- Begin DoDot:1
- +2 SET GMI=+^LR(LRDFN,"CY",IX,2,OT,1,GMD,0)
- +3 SET ^TMP("LRCY",$JOB,IX,"OT"_OT,"M"_GMM)=$$GET1^DIQ(61.1,GMI,.01,"I")
- +4 DO E
- End DoDot:1
- +5 QUIT
- E ; Get Etiology Field data
- +1 NEW GMI,GME,ETIOL
- SET GME=0
- FOR
- SET GME=$ORDER(^LR(LRDFN,"CY",IX,2,OT,2,GMM,1,GME))
- if GME'>0
- QUIT
- Begin DoDot:1
- +2 SET GMI=+^LR(LRDFN,"CY",IX,2,OT,2,GMM,1,GME,0)
- +3 SET ^TMP("LRCY",$JOB,IX,"OT"_OT,"M"_GMM,"E"_GME)=$$GET1^DIQ(61.2,GMI,.01,"I")
- End DoDot:1
- +4 QUIT
- P ; Get Procedure Field data
- +1 NEW GMI,GMP,PROC
- SET GMP=0
- FOR
- SET GMP=$ORDER(^LR(LRDFN,"CY",IX,2,OT,4,GMP))
- if GMP=""
- QUIT
- Begin DoDot:1
- +2 SET GMI=+^LR(LRDFN,"CY",IX,2,OT,4,GMP,0)
- +3 SET ^TMP("LRCY",$JOB,IX,"OT"_OT,"P"_GMP)=$$GET1^DIQ(61.5,GMI,.01,"I")
- End DoDot:1
- +4 QUIT