GMTSDESC ; SLC/AGP - APIS TO RETURN HS TYPE AND HS OBJECTS DESC ; 05/28/2008
;;2.7;Health Summary;**89**;Oct 20, 1995;Build 61
;
Q
BEG(OUTPUT,IEN,FILENUM,CNT) ;
N DTYPE,NODE
S DTYPE=$S(FILENUM=142:"Health Summary Type",FILENUM=142.1:"Local Health Summary Component",FILENUM=142.5:"Health Summary Object",1:"")
;S CNT=CNT+1 S @OUTPUT@(CNT)=$$REPEAT^XLFSTR("-",79)
S CNT=CNT+1 S @OUTPUT@(CNT)=DTYPE_":"
;S CNT=CNT+1 S @OUTPUT@(CNT)=$J(" ",24)_"Name: "_$P(NODE,U)
Q
;
COMP(OUTPUT,IEN,FILENUM,CNT) ;
I IEN<99999 Q
D BEG(.OUTPUT,IEN,FILENUM,.CNT)
N GBL,NODE,TEXT
S NODE=$G(^GMT(142.1,IEN,0))
S TEXT=$$LJ^XLFSTR($P(NODE,U),50)_"Abbreviation: "_$P(NODE,U,4)
S CNT=CNT+1,@OUTPUT@(CNT)=TEXT
I $D(^GMT(142.1,IEN,3.5,0))>0 D
.S GBL=$NA(^GMT(142.1,IEN,3.5)) D COMPM(.OUTPUT,IEN,3.5,GBL,.CNT)
S CNT=CNT+1,@OUTPUT@(CNT)="Time Limits Applicable: "_$P(NODE,U,3)
S CNT=CNT+1,@OUTPUT@(CNT)="Maximum Occurrences Applicable: "_$P(NODE,U,3)
I $P(NODE,U,10)="Y" S CNT=CNT+1,@OUTPUT@(CNT)="Hospital Location Applicable: Y"
I $P(NODE,U,11)="Y" S CNT=CNT+1,@OUTPUT@(CNT)="ICD Text Applicable: Y"
I $P(NODE,U,12)="Y" S CNT=CNT+1,@OUTPUT@(CNT)="Provider Narrative Applicable: Y"
I $P(NODE,U,14)="Y" S CNT=CNT+1,@OUTPUT@(CNT)="CPT Narrative Applicable: Y"
I $P(NODE,U,13)'="" S CNT=CNT+1,@OUTPUT@(CNT)="Prefix: "_$P(NODE,U,13)
I $P(NODE,U,2)'="" S CNT=CNT+1,@OUTPUT@(CNT)="Print Routine: "_$P(NODE,U,2)
I $D(^GMT(142.1,IEN,.1,0))>0 D
.S GBL=$NA(^GMT(142.1,IEN,.1)) D COMPM(.OUTPUT,IEN,.1,GBL,.CNT)
I $D(^GMT(142.1,IEN,1,0))>0 D
.S GBL=$NA(^GMT(142.1,IEN,1)) D COMPM(.OUTPUT,IEN,1,GBL,.CNT)
Q
;
COMPM(OUTPUT,IEN,SUBSC,GBL,CNT) ;
N I,INDENT,NODE,TEXT
I SUBSC=3.5 S INDENT="",TITLE="Description:"
I SUBSC=.1 S INDENT=$J(" ",5),TITLE="External/Extract Routine(s):"
I SUBSC=1 S INDENT=$J(" ",5),TITLE="Selection File(s):"
S CNT=CNT+1,@OUTPUT@(CNT)=TITLE
S I=0 F S I=$O(@GBL@(I)) Q:I'>0 D
.I SUBSC=1 D Q
..S NODE=@GBL@(I,0)
..S TEXT=INDENT_"File: "_$P(^DIC($P(NODE,U),0),U)
..S TEXT=TEXT_" Selection Count Limit: "_$P(NODE,U,2)
..S CNT=CNT+1,@OUTPUT@(CNT)=TEXT
.S CNT=CNT+1,@OUTPUT@(CNT)=INDENT_$G(@GBL@(I,0))
Q
;
EN(IEN,FILENUM,SUB) ;
I $D(^TMP($J,SUB,IEN))>0 Q
N CNT,OUTPUT
S CNT=0
S OUTPUT=$NA(^TMP($J,SUB,IEN))
D DIRECT(.OUTPUT,IEN,FILENUM,.CNT)
Q
;
DIRECT(OUTPUT,IEN,FILENUM,CNT) ;
N ORDIALOG,TYPE
I FILENUM=142.1 D COMP(.OUTPUT,IEN,FILENUM,.CNT)
I FILENUM=142 D TYPE(.OUTPUT,IEN,FILENUM,.CNT)
I FILENUM=142.5 D OBJECT(.OUTPUT,IEN,FILENUM,.CNT)
Q
;
N TEXT
S TEXT=$$REPEAT^XLFSTR(" ",35)_"Max"_$$REPEAT^XLFSTR(" ",8)_"Hos"
S TEXT=TEXT_" ICD Pro CPT"
S CNT=CNT+1,@OUTPUT@(CNT)=TEXT
S TEXT="Abb Ord Component Name"_$$REPEAT^XLFSTR(" ",8)_"OCC"
S TEXT=TEXT_" Time Loc Text Nar Mod Selection"
S CNT=CNT+1,@OUTPUT@(CNT)=TEXT
Q
;
OBJECT(OUTPUT,IEN,FILENUM,CNT) ;
D BEG(.OUTPUT,IEN,FILENUM,.CNT)
N NUM,OBJ
D EXTRACT^GMTSOBJ(IEN,.OBJ)
S NUM=0 F S NUM=$O(OBJ("D",NUM)) Q:NUM'>0 D
.S CNT=CNT+1,@OUTPUT@(CNT)=$G(OBJ("D",NUM))
Q
TYPE(OUTPUT,IEN,FILENUM,CNT) ;
D BEG(.OUTPUT,IEN,FILENUM,.CNT)
N ARRAY,ERROR,IENS,NODE,NUM,SEL,SELNAM,TEXT
S NODE=$G(^GMT(142,IEN,0))
S CNT=CNT+1,@OUTPUT@(CNT)=$$RJ^XLFSTR("Name: ",30)_$P(NODE,U)
S CNT=CNT+1,@OUTPUT@(CNT)=$$RJ^XLFSTR("Suppress Comp Without Data:",30)_$P(NODE,U,5)
D HEADER(.OUTPUT,.CNT)
S NUM=0 F S NUM=$O(^GMT(142,IEN,1,NUM)) Q:NUM'>0 D
.S NODE=$G(^GMT(142,IEN,1,NUM,0))
.S CNT=CNT+1,@OUTPUT@(CNT)=$$TYPETEXT(NODE)
.S SEL=0 F S SEL=$O(^GMT(142,IEN,1,NUM,1,SEL)) Q:SEL'>0 D
..S IENS=SEL_","_NUM_","_IEN_","
..D GETS^DIQ(142.14,IENS,"**","E","ARRAY","ERROR")
..S SELNAM=$G(ARRAY(142.14,IENS,.01,"E"))
..S CNT=CNT+1,@OUTPUT@(CNT)=$$REPEAT^XLFSTR(" ",67)_SELNAM
Q
;
TYPETEXT(NODE) ;
N ABB,CIEN,NAME
S CIEN=$P(NODE,U,2) Q:CIEN'>0
S NAME=$P($G(^GMT(142.1,CIEN,0)),U)
S ABB=$P($G(^GMT(142.1,CIEN,0)),U,4)
S TEXT=$$LJ^XLFSTR(ABB,6)
S TEXT=TEXT_$$LJ^XLFSTR($P(NODE,U),7)
S TEXT=TEXT_$$LJ^XLFSTR($E(NAME,1,21),22)
S TEXT=TEXT_$$LJ^XLFSTR($P(NODE,U,3),5)
S TEXT=TEXT_$$LJ^XLFSTR($P(NODE,U,4),6)
S TEXT=TEXT_$$LJ^XLFSTR($P(NODE,U,6),5)
S TEXT=TEXT_$$LJ^XLFSTR($P(NODE,U,7),6)
S TEXT=TEXT_$$LJ^XLFSTR($P(NODE,U,8),5)
S TEXT=TEXT_$$LJ^XLFSTR($P(NODE,U,9),8)
Q TEXT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSDESC 4326 printed Dec 13, 2024@01:57:18 Page 2
GMTSDESC ; SLC/AGP - APIS TO RETURN HS TYPE AND HS OBJECTS DESC ; 05/28/2008
+1 ;;2.7;Health Summary;**89**;Oct 20, 1995;Build 61
+2 ;
+3 QUIT
BEG(OUTPUT,IEN,FILENUM,CNT) ;
+1 NEW DTYPE,NODE
+2 SET DTYPE=$SELECT(FILENUM=142:"Health Summary Type",FILENUM=142.1:"Local Health Summary Component",FILENUM=142.5:"Health Summary Object",1:"")
+3 ;S CNT=CNT+1 S @OUTPUT@(CNT)=$$REPEAT^XLFSTR("-",79)
+4 SET CNT=CNT+1
SET @OUTPUT@(CNT)=DTYPE_":"
+5 ;S CNT=CNT+1 S @OUTPUT@(CNT)=$J(" ",24)_"Name: "_$P(NODE,U)
+6 QUIT
+7 ;
COMP(OUTPUT,IEN,FILENUM,CNT) ;
+1 IF IEN<99999
QUIT
+2 DO BEG(.OUTPUT,IEN,FILENUM,.CNT)
+3 NEW GBL,NODE,TEXT
+4 SET NODE=$GET(^GMT(142.1,IEN,0))
+5 SET TEXT=$$LJ^XLFSTR($PIECE(NODE,U),50)_"Abbreviation: "_$PIECE(NODE,U,4)
+6 SET CNT=CNT+1
SET @OUTPUT@(CNT)=TEXT
+7 IF $DATA(^GMT(142.1,IEN,3.5,0))>0
Begin DoDot:1
+8 SET GBL=$NAME(^GMT(142.1,IEN,3.5))
DO COMPM(.OUTPUT,IEN,3.5,GBL,.CNT)
End DoDot:1
+9 SET CNT=CNT+1
SET @OUTPUT@(CNT)="Time Limits Applicable: "_$PIECE(NODE,U,3)
+10 SET CNT=CNT+1
SET @OUTPUT@(CNT)="Maximum Occurrences Applicable: "_$PIECE(NODE,U,3)
+11 IF $PIECE(NODE,U,10)="Y"
SET CNT=CNT+1
SET @OUTPUT@(CNT)="Hospital Location Applicable: Y"
+12 IF $PIECE(NODE,U,11)="Y"
SET CNT=CNT+1
SET @OUTPUT@(CNT)="ICD Text Applicable: Y"
+13 IF $PIECE(NODE,U,12)="Y"
SET CNT=CNT+1
SET @OUTPUT@(CNT)="Provider Narrative Applicable: Y"
+14 IF $PIECE(NODE,U,14)="Y"
SET CNT=CNT+1
SET @OUTPUT@(CNT)="CPT Narrative Applicable: Y"
+15 IF $PIECE(NODE,U,13)'=""
SET CNT=CNT+1
SET @OUTPUT@(CNT)="Prefix: "_$PIECE(NODE,U,13)
+16 IF $PIECE(NODE,U,2)'=""
SET CNT=CNT+1
SET @OUTPUT@(CNT)="Print Routine: "_$PIECE(NODE,U,2)
+17 IF $DATA(^GMT(142.1,IEN,.1,0))>0
Begin DoDot:1
+18 SET GBL=$NAME(^GMT(142.1,IEN,.1))
DO COMPM(.OUTPUT,IEN,.1,GBL,.CNT)
End DoDot:1
+19 IF $DATA(^GMT(142.1,IEN,1,0))>0
Begin DoDot:1
+20 SET GBL=$NAME(^GMT(142.1,IEN,1))
DO COMPM(.OUTPUT,IEN,1,GBL,.CNT)
End DoDot:1
+21 QUIT
+22 ;
COMPM(OUTPUT,IEN,SUBSC,GBL,CNT) ;
+1 NEW I,INDENT,NODE,TEXT
+2 IF SUBSC=3.5
SET INDENT=""
SET TITLE="Description:"
+3 IF SUBSC=.1
SET INDENT=$JUSTIFY(" ",5)
SET TITLE="External/Extract Routine(s):"
+4 IF SUBSC=1
SET INDENT=$JUSTIFY(" ",5)
SET TITLE="Selection File(s):"
+5 SET CNT=CNT+1
SET @OUTPUT@(CNT)=TITLE
+6 SET I=0
FOR
SET I=$ORDER(@GBL@(I))
if I'>0
QUIT
Begin DoDot:1
+7 IF SUBSC=1
Begin DoDot:2
+8 SET NODE=@GBL@(I,0)
+9 SET TEXT=INDENT_"File: "_$PIECE(^DIC($PIECE(NODE,U),0),U)
+10 SET TEXT=TEXT_" Selection Count Limit: "_$PIECE(NODE,U,2)
+11 SET CNT=CNT+1
SET @OUTPUT@(CNT)=TEXT
End DoDot:2
QUIT
+12 SET CNT=CNT+1
SET @OUTPUT@(CNT)=INDENT_$GET(@GBL@(I,0))
End DoDot:1
+13 QUIT
+14 ;
EN(IEN,FILENUM,SUB) ;
+1 IF $DATA(^TMP($JOB,SUB,IEN))>0
QUIT
+2 NEW CNT,OUTPUT
+3 SET CNT=0
+4 SET OUTPUT=$NAME(^TMP($JOB,SUB,IEN))
+5 DO DIRECT(.OUTPUT,IEN,FILENUM,.CNT)
+6 QUIT
+7 ;
DIRECT(OUTPUT,IEN,FILENUM,CNT) ;
+1 NEW ORDIALOG,TYPE
+2 IF FILENUM=142.1
DO COMP(.OUTPUT,IEN,FILENUM,.CNT)
+3 IF FILENUM=142
DO TYPE(.OUTPUT,IEN,FILENUM,.CNT)
+4 IF FILENUM=142.5
DO OBJECT(.OUTPUT,IEN,FILENUM,.CNT)
+5 QUIT
+6 ;
+1 NEW TEXT
+2 SET TEXT=$$REPEAT^XLFSTR(" ",35)_"Max"_$$REPEAT^XLFSTR(" ",8)_"Hos"
+3 SET TEXT=TEXT_" ICD Pro CPT"
+4 SET CNT=CNT+1
SET @OUTPUT@(CNT)=TEXT
+5 SET TEXT="Abb Ord Component Name"_$$REPEAT^XLFSTR(" ",8)_"OCC"
+6 SET TEXT=TEXT_" Time Loc Text Nar Mod Selection"
+7 SET CNT=CNT+1
SET @OUTPUT@(CNT)=TEXT
+8 QUIT
+9 ;
OBJECT(OUTPUT,IEN,FILENUM,CNT) ;
+1 DO BEG(.OUTPUT,IEN,FILENUM,.CNT)
+2 NEW NUM,OBJ
+3 DO EXTRACT^GMTSOBJ(IEN,.OBJ)
+4 SET NUM=0
FOR
SET NUM=$ORDER(OBJ("D",NUM))
if NUM'>0
QUIT
Begin DoDot:1
+5 SET CNT=CNT+1
SET @OUTPUT@(CNT)=$GET(OBJ("D",NUM))
End DoDot:1
+6 QUIT
TYPE(OUTPUT,IEN,FILENUM,CNT) ;
+1 DO BEG(.OUTPUT,IEN,FILENUM,.CNT)
+2 NEW ARRAY,ERROR,IENS,NODE,NUM,SEL,SELNAM,TEXT
+3 SET NODE=$GET(^GMT(142,IEN,0))
+4 SET CNT=CNT+1
SET @OUTPUT@(CNT)=$$RJ^XLFSTR("Name: ",30)_$PIECE(NODE,U)
+5 SET CNT=CNT+1
SET @OUTPUT@(CNT)=$$RJ^XLFSTR("Suppress Comp Without Data:",30)_$PIECE(NODE,U,5)
+6 DO HEADER(.OUTPUT,.CNT)
+7 SET NUM=0
FOR
SET NUM=$ORDER(^GMT(142,IEN,1,NUM))
if NUM'>0
QUIT
Begin DoDot:1
+8 SET NODE=$GET(^GMT(142,IEN,1,NUM,0))
+9 SET CNT=CNT+1
SET @OUTPUT@(CNT)=$$TYPETEXT(NODE)
+10 SET SEL=0
FOR
SET SEL=$ORDER(^GMT(142,IEN,1,NUM,1,SEL))
if SEL'>0
QUIT
Begin DoDot:2
+11 SET IENS=SEL_","_NUM_","_IEN_","
+12 DO GETS^DIQ(142.14,IENS,"**","E","ARRAY","ERROR")
+13 SET SELNAM=$GET(ARRAY(142.14,IENS,.01,"E"))
+14 SET CNT=CNT+1
SET @OUTPUT@(CNT)=$$REPEAT^XLFSTR(" ",67)_SELNAM
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
TYPETEXT(NODE) ;
+1 NEW ABB,CIEN,NAME
+2 SET CIEN=$PIECE(NODE,U,2)
if CIEN'>0
QUIT
+3 SET NAME=$PIECE($GET(^GMT(142.1,CIEN,0)),U)
+4 SET ABB=$PIECE($GET(^GMT(142.1,CIEN,0)),U,4)
+5 SET TEXT=$$LJ^XLFSTR(ABB,6)
+6 SET TEXT=TEXT_$$LJ^XLFSTR($PIECE(NODE,U),7)
+7 SET TEXT=TEXT_$$LJ^XLFSTR($EXTRACT(NAME,1,21),22)
+8 SET TEXT=TEXT_$$LJ^XLFSTR($PIECE(NODE,U,3),5)
+9 SET TEXT=TEXT_$$LJ^XLFSTR($PIECE(NODE,U,4),6)
+10 SET TEXT=TEXT_$$LJ^XLFSTR($PIECE(NODE,U,6),5)
+11 SET TEXT=TEXT_$$LJ^XLFSTR($PIECE(NODE,U,7),6)
+12 SET TEXT=TEXT_$$LJ^XLFSTR($PIECE(NODE,U,8),5)
+13 SET TEXT=TEXT_$$LJ^XLFSTR($PIECE(NODE,U,9),8)
+14 QUIT TEXT
+15 ;
