- 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 Feb 18, 2025@23:23:40 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 ;