- GMTSPXU1 ; SLC/SBW,TC - PCE Utilities sub-routines ;06/25/15 15:51
- ;;2.7;Health Summary;**10,37,71,86,101,111**;Oct 20, 1995;Build 17
- ;
- ; External References
- ; ICR 5699 $$ICDDATA,ICDDESC^ICDXCODE
- ; ICR 1995 $$CPT^ICPTCOD
- ; ICR 5679 $$IMPDATE^LEXU
- ; ICR 10026 ^DIR
- ; ICR 10011 ^DIWP
- ;
- GETICDDX(GMTSICD,GMTSICF,GMMOD,GMTSDATE,GMTSCSYS) ; Entry point to get ICD data
- N REC,CODE,NAME,DESC,ICDX,ICDI,GMTSICDA
- S GMTSICD=$G(GMTSICD),GMTSICF=$G(GMTSICF),GMMOD=$G(GMMOD),GMTSDATE=$G(GMTSDATE,DT),GMTSCSYS=$G(GMTSCSYS)
- S ICDX=$$ICDDATA^ICDXCODE(GMTSCSYS,+GMTSICD,GMTSDATE,"I")
- S REC(80,GMTSICD,.01,"E")=$P(ICDX,"^",2)
- S REC(80,GMTSICD,.01,"I")=$P(ICDX,"^",2)
- S REC(80,GMTSICD,3,"E")=$P(ICDX,"^",4)
- S REC(80,GMTSICD,3,"I")=$P(ICDX,"^",4)
- S ICDI=$$ICDDESC^ICDXCODE(GMTSCSYS,$P(ICDX,"^",2),GMTSDATE,.GMTSICDA)
- S REC(80,GMTSICD,10,"E")=$G(GMTSICDA(1))
- S REC(80,GMTSICD,10,"I")=$G(GMTSICDA(1))
- S CODE=REC(80,GMTSICD,.01,"I")
- S NAME=REC(80,GMTSICD,3,"E")
- S DESC=REC(80,GMTSICD,10,"E")
- S:GMTSICF="L"!(GMTSICF["LONG TEXT")!(GMTSICF="") GMTSICD=CODE_"-"_DESC
- S:GMTSICF="S"!(GMTSICF["SHORT TEXT") GMTSICD=CODE_"-"_NAME
- S:GMTSICF="C"!(GMTSICF["CODE ONLY") GMTSICD=CODE
- S:GMTSICF="T"!(GMTSICF["TEXT ONLY") GMTSICD=DESC
- I $G(GMMOD)]"" S GMMOD=$P(GMMOD,","),GMTSICD=GMMOD_" "_GMTSICD
- S:GMTSICF="N"!(GMTSICF["NONE") GMTSICD=""
- Q
- ;
- GETICDOP(GMTSICD,GMTSICF,GMMOD,GMTSDATE,GMTSSHCS) ; Entry point to get ICD data
- S GMTSICD=$G(GMTSICD),GMTSICF=$G(GMTSICF),GMMOD=$G(GMMOD),GMTSDATE=$G(GMTSDATE,DT),GMTSSHCS=$G(GMTSSHCS,0)
- N REC,CODE,NAME,DESC,ICDX,ICDI,GMTSICDA
- S ICDX=$$ICDDATA^ICDXCODE("PROC",+GMTSICD,GMTSDATE)
- S REC(80.1,GMTSICD,.01,"E")=$P(ICDX,"^",2)
- S REC(80.1,GMTSICD,.01,"I")=$P(ICDX,"^",2)
- S REC(80.1,GMTSICD,4,"E")=$P(ICDX,"^",5)
- S REC(80.1,GMTSICD,4,"I")=$P(ICDX,"^",5)
- S ICDI=$$ICDDESC^ICDXCODE("PROC",$P(ICDX,"^",2),GMTSDATE,.GMTSICDA)
- S REC(80.1,GMTSICD,10,"E")=$G(GMTSICDA(1))
- S REC(80.1,GMTSICD,10,"I")=$G(GMTSICDA(1))
- S CODE=REC(80.1,GMTSICD,.01,"I")
- S NAME=REC(80.1,GMTSICD,4,"E")
- S DESC=REC(80.1,GMTSICD,10,"E")
- I GMTSSHCS S CODE=CODE_"("_$$GETICDCD(GMTSDATE,"PROC")_")"
- S:GMTSICF="L"!(GMTSICF="") GMTSICD=CODE_"-"_DESC
- S:GMTSICF="S" GMTSICD=CODE_"-"_NAME
- S:GMTSICF="C" GMTSICD=CODE
- S:GMTSICF="T" GMTSICD=DESC
- S:GMTSICF="N" GMTSICD=""
- Q
- ;
- GETCPT(GMTSCPT) ; Entry point to get CPT data
- N ICPT S GMTSCPT=+($G(GMTSCPT)) Q:GMTSCPT=0 ""
- S ICPT=$$CPT^ICPTCOD(+GMTSCPT),ICPT=$P(ICPT,"^",2)_"-"_$P(ICPT,"^",3)
- Q ICPT
- ;
- TXTFMT(GMTSICD,GMTSNARR,GMICL,GMTAB,DIWL,GMTSQTY,GMTSPRIM) ; Formats GMTSICD & GMTSNARR together
- I GMTSICD="",GMTSNARR="" Q
- N DIWR,DIWF,X
- S DIWR=80-(GMICL+GMTAB)
- K ^UTILITY($J,"W")
- I $G(GMTSICD)]"" S X=GMTSICD S:$G(GMTSNARR)]"" X=X_"; "
- I $G(GMTSNARR)]"" S X=$G(X)_GMTSNARR D
- . I $G(GMTSPRIM)]"" S X=X_GMTSPRIM
- . I $G(GMTSQTY)]"" S X=X_GMTSQTY
- . D ^DIWP
- I $G(GMTSNARR)']"" D
- . I $G(GMTSQTY)]"" S X=$G(X)_GMTSQTY
- . I $G(GMTSPRIM)]"" S X=X_GMTSPRIM
- . D ^DIWP
- Q
- ;
- ORDERPRO(GMPROV,GMLEN) ; Re-order and format providers for visit
- N GMCNT,GMTSP,GMNODE,GMP
- S GMCNT=0
- F GMP="P","S","Z" S GMTSP="" F S GMTSP=$O(^TMP("PXHSV",$J,GMTSIVD,GMTSVDF,"P",GMP,GMTSP)) Q:GMTSP'>0 D
- . S GMNODE=^TMP("PXHSV",$J,GMTSIVD,GMTSVDF,"P",GMP,GMTSP)
- . Q:GMNODE']""
- . S GMCNT=GMCNT+1
- . S GMPROV(GMCNT)=$E($P(GMNODE,U),1,GMLEN-4)_$S(GMP="P"!(GMP="S"):" ("_GMP_")",1:"")
- Q
- ;
- ; The following code segments are called from "ROUTINE" type
- ; Menu Options to display items in a file
- ;
- LM ; Entry Point - for GMTS Measurement Panel
- S GMTSLST="^GMT(142.7," G DSPLST
- ;
- DSPLST ; Common code for Health Summary MNX Lists
- K DIR
- I '$D(@(GMTSLST_"""B"")")) W !,"NO ",$P(@(GMTSLST_"0)"),U),"S DEFINED.",! Q
- W @IOF,!!,"Existing ",$P(@(GMTSLST_"0)"),U),"S:",! S GMTSCNT=""
- CONT ; Continue
- F S GMTSCNT=$O(@(GMTSLST_"""B"",GMTSCNT)")) Q:GMTSCNT="" D G:1'[$G(Y)&($L($G(Y))) QUIT
- . N DIR K Y W !,?5,GMTSCNT I (IOSL-3)<$Y S DIR(0)="E" D
- . . D ^DIR W @IOF
- K DIR S DIR(0)="E" D ^DIR W !
- QUIT ; Quit
- K DIR,X,Y,GMTSLST,GMTSCNT
- Q
- GETICDCD(DATE,TYPE) ;
- ; TYPE is either "PROC" or "DIAG"
- ; DATE is the date you want to check the coding system for
- N RET,OUT
- I TYPE="DIAG" S TYPE="10D"
- I TYPE="PROC" S TYPE="10P"
- S RET="ICD-"
- S OUT=10
- I DATE<$$IMPDATE^LEXU(TYPE) S OUT=9
- I TYPE="10P"&(OUT=9) S OUT=OUT_" Proc"
- I TYPE="10P"&(OUT=10) S OUT=OUT_"-PCS"
- S RET=RET_OUT
- Q RET
- ;
- CODESYS(GMTSCODA,GMTSFILE) ; create coding system and label based on IEN
- ;input
- ; GMTSCODA - IEN of code in either file 80 or 80.1
- ; GMTSFILE - 80 or 80.1, should be able to tell based on context when this API is called
- ;ouput
- ; GMTSRET - code from 80 or 80.1 ^ coding system label
- ; or -1 ^ error message
- ; check for error condition using $P($G(GMTSRET),U)=-1 vice +$G(GMTSRET)=-1 as urnary operator
- ; can interpret some procedure codes as scientific notation and trigger <MAXNUMBER> error (e.g. "3E1988X").
- N GMTSCSYS,GMTSCODE,GMTSRET
- S GMTSCSYS=$$CSI^ICDEX($G(GMTSFILE),$G(GMTSCODA)) ;Coding system for IEN or NULL
- I $G(GMTSCSYS)="" S GMTSRET="-1^Error determining coding system" Q GMTSRET
- S GMTSCSYS=$$SNAM^ICDEX($G(GMTSCSYS)) ;short versioned description or -1
- I $G(GMTSCSYS)="-1" S GMTSRET="-1^Error determining coding system" Q GMTSRET
- ;
- S GMTSCODE=$$CODEC^ICDEX($G(GMTSFILE),$G(GMTSCODA)) ;Code from an IEN or -1^error message
- I $P($G(GMTSCODE),U)=-1 S GMTSRET="-1^Error: "_$P($G(GMTSCODE),U,2) Q GMTSRET
- S GMTSRET=$G(GMTSCODE)_U_$G(GMTSCSYS)
- Q GMTSRET
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPXU1 5568 printed Jan 18, 2025@03:01:06 Page 2
- GMTSPXU1 ; SLC/SBW,TC - PCE Utilities sub-routines ;06/25/15 15:51
- +1 ;;2.7;Health Summary;**10,37,71,86,101,111**;Oct 20, 1995;Build 17
- +2 ;
- +3 ; External References
- +4 ; ICR 5699 $$ICDDATA,ICDDESC^ICDXCODE
- +5 ; ICR 1995 $$CPT^ICPTCOD
- +6 ; ICR 5679 $$IMPDATE^LEXU
- +7 ; ICR 10026 ^DIR
- +8 ; ICR 10011 ^DIWP
- +9 ;
- GETICDDX(GMTSICD,GMTSICF,GMMOD,GMTSDATE,GMTSCSYS) ; Entry point to get ICD data
- +1 NEW REC,CODE,NAME,DESC,ICDX,ICDI,GMTSICDA
- +2 SET GMTSICD=$GET(GMTSICD)
- SET GMTSICF=$GET(GMTSICF)
- SET GMMOD=$GET(GMMOD)
- SET GMTSDATE=$GET(GMTSDATE,DT)
- SET GMTSCSYS=$GET(GMTSCSYS)
- +3 SET ICDX=$$ICDDATA^ICDXCODE(GMTSCSYS,+GMTSICD,GMTSDATE,"I")
- +4 SET REC(80,GMTSICD,.01,"E")=$PIECE(ICDX,"^",2)
- +5 SET REC(80,GMTSICD,.01,"I")=$PIECE(ICDX,"^",2)
- +6 SET REC(80,GMTSICD,3,"E")=$PIECE(ICDX,"^",4)
- +7 SET REC(80,GMTSICD,3,"I")=$PIECE(ICDX,"^",4)
- +8 SET ICDI=$$ICDDESC^ICDXCODE(GMTSCSYS,$PIECE(ICDX,"^",2),GMTSDATE,.GMTSICDA)
- +9 SET REC(80,GMTSICD,10,"E")=$GET(GMTSICDA(1))
- +10 SET REC(80,GMTSICD,10,"I")=$GET(GMTSICDA(1))
- +11 SET CODE=REC(80,GMTSICD,.01,"I")
- +12 SET NAME=REC(80,GMTSICD,3,"E")
- +13 SET DESC=REC(80,GMTSICD,10,"E")
- +14 if GMTSICF="L"!(GMTSICF["LONG TEXT")!(GMTSICF="")
- SET GMTSICD=CODE_"-"_DESC
- +15 if GMTSICF="S"!(GMTSICF["SHORT TEXT")
- SET GMTSICD=CODE_"-"_NAME
- +16 if GMTSICF="C"!(GMTSICF["CODE ONLY")
- SET GMTSICD=CODE
- +17 if GMTSICF="T"!(GMTSICF["TEXT ONLY")
- SET GMTSICD=DESC
- +18 IF $GET(GMMOD)]""
- SET GMMOD=$PIECE(GMMOD,",")
- SET GMTSICD=GMMOD_" "_GMTSICD
- +19 if GMTSICF="N"!(GMTSICF["NONE")
- SET GMTSICD=""
- +20 QUIT
- +21 ;
- GETICDOP(GMTSICD,GMTSICF,GMMOD,GMTSDATE,GMTSSHCS) ; Entry point to get ICD data
- +1 SET GMTSICD=$GET(GMTSICD)
- SET GMTSICF=$GET(GMTSICF)
- SET GMMOD=$GET(GMMOD)
- SET GMTSDATE=$GET(GMTSDATE,DT)
- SET GMTSSHCS=$GET(GMTSSHCS,0)
- +2 NEW REC,CODE,NAME,DESC,ICDX,ICDI,GMTSICDA
- +3 SET ICDX=$$ICDDATA^ICDXCODE("PROC",+GMTSICD,GMTSDATE)
- +4 SET REC(80.1,GMTSICD,.01,"E")=$PIECE(ICDX,"^",2)
- +5 SET REC(80.1,GMTSICD,.01,"I")=$PIECE(ICDX,"^",2)
- +6 SET REC(80.1,GMTSICD,4,"E")=$PIECE(ICDX,"^",5)
- +7 SET REC(80.1,GMTSICD,4,"I")=$PIECE(ICDX,"^",5)
- +8 SET ICDI=$$ICDDESC^ICDXCODE("PROC",$PIECE(ICDX,"^",2),GMTSDATE,.GMTSICDA)
- +9 SET REC(80.1,GMTSICD,10,"E")=$GET(GMTSICDA(1))
- +10 SET REC(80.1,GMTSICD,10,"I")=$GET(GMTSICDA(1))
- +11 SET CODE=REC(80.1,GMTSICD,.01,"I")
- +12 SET NAME=REC(80.1,GMTSICD,4,"E")
- +13 SET DESC=REC(80.1,GMTSICD,10,"E")
- +14 IF GMTSSHCS
- SET CODE=CODE_"("_$$GETICDCD(GMTSDATE,"PROC")_")"
- +15 if GMTSICF="L"!(GMTSICF="")
- SET GMTSICD=CODE_"-"_DESC
- +16 if GMTSICF="S"
- SET GMTSICD=CODE_"-"_NAME
- +17 if GMTSICF="C"
- SET GMTSICD=CODE
- +18 if GMTSICF="T"
- SET GMTSICD=DESC
- +19 if GMTSICF="N"
- SET GMTSICD=""
- +20 QUIT
- +21 ;
- GETCPT(GMTSCPT) ; Entry point to get CPT data
- +1 NEW ICPT
- SET GMTSCPT=+($GET(GMTSCPT))
- if GMTSCPT=0
- QUIT ""
- +2 SET ICPT=$$CPT^ICPTCOD(+GMTSCPT)
- SET ICPT=$PIECE(ICPT,"^",2)_"-"_$PIECE(ICPT,"^",3)
- +3 QUIT ICPT
- +4 ;
- TXTFMT(GMTSICD,GMTSNARR,GMICL,GMTAB,DIWL,GMTSQTY,GMTSPRIM) ; Formats GMTSICD & GMTSNARR together
- +1 IF GMTSICD=""
- IF GMTSNARR=""
- QUIT
- +2 NEW DIWR,DIWF,X
- +3 SET DIWR=80-(GMICL+GMTAB)
- +4 KILL ^UTILITY($JOB,"W")
- +5 IF $GET(GMTSICD)]""
- SET X=GMTSICD
- if $GET(GMTSNARR)]""
- SET X=X_"; "
- +6 IF $GET(GMTSNARR)]""
- SET X=$GET(X)_GMTSNARR
- Begin DoDot:1
- +7 IF $GET(GMTSPRIM)]""
- SET X=X_GMTSPRIM
- +8 IF $GET(GMTSQTY)]""
- SET X=X_GMTSQTY
- +9 DO ^DIWP
- End DoDot:1
- +10 IF $GET(GMTSNARR)']""
- Begin DoDot:1
- +11 IF $GET(GMTSQTY)]""
- SET X=$GET(X)_GMTSQTY
- +12 IF $GET(GMTSPRIM)]""
- SET X=X_GMTSPRIM
- +13 DO ^DIWP
- End DoDot:1
- +14 QUIT
- +15 ;
- ORDERPRO(GMPROV,GMLEN) ; Re-order and format providers for visit
- +1 NEW GMCNT,GMTSP,GMNODE,GMP
- +2 SET GMCNT=0
- +3 FOR GMP="P","S","Z"
- SET GMTSP=""
- FOR
- SET GMTSP=$ORDER(^TMP("PXHSV",$JOB,GMTSIVD,GMTSVDF,"P",GMP,GMTSP))
- if GMTSP'>0
- QUIT
- Begin DoDot:1
- +4 SET GMNODE=^TMP("PXHSV",$JOB,GMTSIVD,GMTSVDF,"P",GMP,GMTSP)
- +5 if GMNODE']""
- QUIT
- +6 SET GMCNT=GMCNT+1
- +7 SET GMPROV(GMCNT)=$EXTRACT($PIECE(GMNODE,U),1,GMLEN-4)_$SELECT(GMP="P"!(GMP="S"):" ("_GMP_")",1:"")
- End DoDot:1
- +8 QUIT
- +9 ;
- +10 ; The following code segments are called from "ROUTINE" type
- +11 ; Menu Options to display items in a file
- +12 ;
- LM ; Entry Point - for GMTS Measurement Panel
- +1 SET GMTSLST="^GMT(142.7,"
- GOTO DSPLST
- +2 ;
- DSPLST ; Common code for Health Summary MNX Lists
- +1 KILL DIR
- +2 IF '$DATA(@(GMTSLST_"""B"")"))
- WRITE !,"NO ",$PIECE(@(GMTSLST_"0)"),U),"S DEFINED.",!
- QUIT
- +3 WRITE @IOF,!!,"Existing ",$PIECE(@(GMTSLST_"0)"),U),"S:",!
- SET GMTSCNT=""
- CONT ; Continue
- +1 FOR
- SET GMTSCNT=$ORDER(@(GMTSLST_"""B"",GMTSCNT)"))
- if GMTSCNT=""
- QUIT
- Begin DoDot:1
- +2 NEW DIR
- KILL Y
- WRITE !,?5,GMTSCNT
- IF (IOSL-3)<$Y
- SET DIR(0)="E"
- Begin DoDot:2
- +3 DO ^DIR
- WRITE @IOF
- End DoDot:2
- End DoDot:1
- if 1'[$GET(Y)&($LENGTH($GET(Y)))
- GOTO QUIT
- +4 KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- WRITE !
- QUIT ; Quit
- +1 KILL DIR,X,Y,GMTSLST,GMTSCNT
- +2 QUIT
- GETICDCD(DATE,TYPE) ;
- +1 ; TYPE is either "PROC" or "DIAG"
- +2 ; DATE is the date you want to check the coding system for
- +3 NEW RET,OUT
- +4 IF TYPE="DIAG"
- SET TYPE="10D"
- +5 IF TYPE="PROC"
- SET TYPE="10P"
- +6 SET RET="ICD-"
- +7 SET OUT=10
- +8 IF DATE<$$IMPDATE^LEXU(TYPE)
- SET OUT=9
- +9 IF TYPE="10P"&(OUT=9)
- SET OUT=OUT_" Proc"
- +10 IF TYPE="10P"&(OUT=10)
- SET OUT=OUT_"-PCS"
- +11 SET RET=RET_OUT
- +12 QUIT RET
- +13 ;
- CODESYS(GMTSCODA,GMTSFILE) ; create coding system and label based on IEN
- +1 ;input
- +2 ; GMTSCODA - IEN of code in either file 80 or 80.1
- +3 ; GMTSFILE - 80 or 80.1, should be able to tell based on context when this API is called
- +4 ;ouput
- +5 ; GMTSRET - code from 80 or 80.1 ^ coding system label
- +6 ; or -1 ^ error message
- +7 ; check for error condition using $P($G(GMTSRET),U)=-1 vice +$G(GMTSRET)=-1 as urnary operator
- +8 ; can interpret some procedure codes as scientific notation and trigger <MAXNUMBER> error (e.g. "3E1988X").
- +9 NEW GMTSCSYS,GMTSCODE,GMTSRET
- +10 ;Coding system for IEN or NULL
- SET GMTSCSYS=$$CSI^ICDEX($GET(GMTSFILE),$GET(GMTSCODA))
- +11 IF $GET(GMTSCSYS)=""
- SET GMTSRET="-1^Error determining coding system"
- QUIT GMTSRET
- +12 ;short versioned description or -1
- SET GMTSCSYS=$$SNAM^ICDEX($GET(GMTSCSYS))
- +13 IF $GET(GMTSCSYS)="-1"
- SET GMTSRET="-1^Error determining coding system"
- QUIT GMTSRET
- +14 ;
- +15 ;Code from an IEN or -1^error message
- SET GMTSCODE=$$CODEC^ICDEX($GET(GMTSFILE),$GET(GMTSCODA))
- +16 IF $PIECE($GET(GMTSCODE),U)=-1
- SET GMTSRET="-1^Error: "_$PIECE($GET(GMTSCODE),U,2)
- QUIT GMTSRET
- +17 SET GMTSRET=$GET(GMTSCODE)_U_$GET(GMTSCSYS)
- +18 QUIT GMTSRET