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

GMTSPXU1.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; External References
  1. ; ICR 5699 $$ICDDATA,ICDDESC^ICDXCODE
  1. ; ICR 1995 $$CPT^ICPTCOD
  1. ; ICR 5679 $$IMPDATE^LEXU
  1. ; ICR 10026 ^DIR
  1. ; ICR 10011 ^DIWP
  1. ;
  1. GETICDDX(GMTSICD,GMTSICF,GMMOD,GMTSDATE,GMTSCSYS) ; Entry point to get ICD data
  1. N REC,CODE,NAME,DESC,ICDX,ICDI,GMTSICDA
  1. S GMTSICD=$G(GMTSICD),GMTSICF=$G(GMTSICF),GMMOD=$G(GMMOD),GMTSDATE=$G(GMTSDATE,DT),GMTSCSYS=$G(GMTSCSYS)
  1. S ICDX=$$ICDDATA^ICDXCODE(GMTSCSYS,+GMTSICD,GMTSDATE,"I")
  1. S REC(80,GMTSICD,.01,"E")=$P(ICDX,"^",2)
  1. S REC(80,GMTSICD,.01,"I")=$P(ICDX,"^",2)
  1. S REC(80,GMTSICD,3,"E")=$P(ICDX,"^",4)
  1. S REC(80,GMTSICD,3,"I")=$P(ICDX,"^",4)
  1. S ICDI=$$ICDDESC^ICDXCODE(GMTSCSYS,$P(ICDX,"^",2),GMTSDATE,.GMTSICDA)
  1. S REC(80,GMTSICD,10,"E")=$G(GMTSICDA(1))
  1. S REC(80,GMTSICD,10,"I")=$G(GMTSICDA(1))
  1. S CODE=REC(80,GMTSICD,.01,"I")
  1. S NAME=REC(80,GMTSICD,3,"E")
  1. S DESC=REC(80,GMTSICD,10,"E")
  1. S:GMTSICF="L"!(GMTSICF["LONG TEXT")!(GMTSICF="") GMTSICD=CODE_"-"_DESC
  1. S:GMTSICF="S"!(GMTSICF["SHORT TEXT") GMTSICD=CODE_"-"_NAME
  1. S:GMTSICF="C"!(GMTSICF["CODE ONLY") GMTSICD=CODE
  1. S:GMTSICF="T"!(GMTSICF["TEXT ONLY") GMTSICD=DESC
  1. I $G(GMMOD)]"" S GMMOD=$P(GMMOD,","),GMTSICD=GMMOD_" "_GMTSICD
  1. S:GMTSICF="N"!(GMTSICF["NONE") GMTSICD=""
  1. Q
  1. ;
  1. GETICDOP(GMTSICD,GMTSICF,GMMOD,GMTSDATE,GMTSSHCS) ; Entry point to get ICD data
  1. S GMTSICD=$G(GMTSICD),GMTSICF=$G(GMTSICF),GMMOD=$G(GMMOD),GMTSDATE=$G(GMTSDATE,DT),GMTSSHCS=$G(GMTSSHCS,0)
  1. N REC,CODE,NAME,DESC,ICDX,ICDI,GMTSICDA
  1. S ICDX=$$ICDDATA^ICDXCODE("PROC",+GMTSICD,GMTSDATE)
  1. S REC(80.1,GMTSICD,.01,"E")=$P(ICDX,"^",2)
  1. S REC(80.1,GMTSICD,.01,"I")=$P(ICDX,"^",2)
  1. S REC(80.1,GMTSICD,4,"E")=$P(ICDX,"^",5)
  1. S REC(80.1,GMTSICD,4,"I")=$P(ICDX,"^",5)
  1. S ICDI=$$ICDDESC^ICDXCODE("PROC",$P(ICDX,"^",2),GMTSDATE,.GMTSICDA)
  1. S REC(80.1,GMTSICD,10,"E")=$G(GMTSICDA(1))
  1. S REC(80.1,GMTSICD,10,"I")=$G(GMTSICDA(1))
  1. S CODE=REC(80.1,GMTSICD,.01,"I")
  1. S NAME=REC(80.1,GMTSICD,4,"E")
  1. S DESC=REC(80.1,GMTSICD,10,"E")
  1. I GMTSSHCS S CODE=CODE_"("_$$GETICDCD(GMTSDATE,"PROC")_")"
  1. S:GMTSICF="L"!(GMTSICF="") GMTSICD=CODE_"-"_DESC
  1. S:GMTSICF="S" GMTSICD=CODE_"-"_NAME
  1. S:GMTSICF="C" GMTSICD=CODE
  1. S:GMTSICF="T" GMTSICD=DESC
  1. S:GMTSICF="N" GMTSICD=""
  1. Q
  1. ;
  1. GETCPT(GMTSCPT) ; Entry point to get CPT data
  1. N ICPT S GMTSCPT=+($G(GMTSCPT)) Q:GMTSCPT=0 ""
  1. S ICPT=$$CPT^ICPTCOD(+GMTSCPT),ICPT=$P(ICPT,"^",2)_"-"_$P(ICPT,"^",3)
  1. Q ICPT
  1. ;
  1. TXTFMT(GMTSICD,GMTSNARR,GMICL,GMTAB,DIWL,GMTSQTY,GMTSPRIM) ; Formats GMTSICD & GMTSNARR together
  1. I GMTSICD="",GMTSNARR="" Q
  1. N DIWR,DIWF,X
  1. S DIWR=80-(GMICL+GMTAB)
  1. K ^UTILITY($J,"W")
  1. I $G(GMTSICD)]"" S X=GMTSICD S:$G(GMTSNARR)]"" X=X_"; "
  1. I $G(GMTSNARR)]"" S X=$G(X)_GMTSNARR D
  1. . I $G(GMTSPRIM)]"" S X=X_GMTSPRIM
  1. . I $G(GMTSQTY)]"" S X=X_GMTSQTY
  1. . D ^DIWP
  1. I $G(GMTSNARR)']"" D
  1. . I $G(GMTSQTY)]"" S X=$G(X)_GMTSQTY
  1. . I $G(GMTSPRIM)]"" S X=X_GMTSPRIM
  1. . D ^DIWP
  1. Q
  1. ;
  1. ORDERPRO(GMPROV,GMLEN) ; Re-order and format providers for visit
  1. N GMCNT,GMTSP,GMNODE,GMP
  1. S GMCNT=0
  1. F GMP="P","S","Z" S GMTSP="" F S GMTSP=$O(^TMP("PXHSV",$J,GMTSIVD,GMTSVDF,"P",GMP,GMTSP)) Q:GMTSP'>0 D
  1. . S GMNODE=^TMP("PXHSV",$J,GMTSIVD,GMTSVDF,"P",GMP,GMTSP)
  1. . Q:GMNODE']""
  1. . S GMCNT=GMCNT+1
  1. . S GMPROV(GMCNT)=$E($P(GMNODE,U),1,GMLEN-4)_$S(GMP="P"!(GMP="S"):" ("_GMP_")",1:"")
  1. Q
  1. ;
  1. ; The following code segments are called from "ROUTINE" type
  1. ; Menu Options to display items in a file
  1. ;
  1. LM ; Entry Point - for GMTS Measurement Panel
  1. S GMTSLST="^GMT(142.7," G DSPLST
  1. ;
  1. DSPLST ; Common code for Health Summary MNX Lists
  1. K DIR
  1. I '$D(@(GMTSLST_"""B"")")) W !,"NO ",$P(@(GMTSLST_"0)"),U),"S DEFINED.",! Q
  1. W @IOF,!!,"Existing ",$P(@(GMTSLST_"0)"),U),"S:",! S GMTSCNT=""
  1. CONT ; Continue
  1. F S GMTSCNT=$O(@(GMTSLST_"""B"",GMTSCNT)")) Q:GMTSCNT="" D G:1'[$G(Y)&($L($G(Y))) QUIT
  1. . N DIR K Y W !,?5,GMTSCNT I (IOSL-3)<$Y S DIR(0)="E" D
  1. . . D ^DIR W @IOF
  1. K DIR S DIR(0)="E" D ^DIR W !
  1. QUIT ; Quit
  1. K DIR,X,Y,GMTSLST,GMTSCNT
  1. Q
  1. GETICDCD(DATE,TYPE) ;
  1. ; TYPE is either "PROC" or "DIAG"
  1. ; DATE is the date you want to check the coding system for
  1. N RET,OUT
  1. I TYPE="DIAG" S TYPE="10D"
  1. I TYPE="PROC" S TYPE="10P"
  1. S RET="ICD-"
  1. S OUT=10
  1. I DATE<$$IMPDATE^LEXU(TYPE) S OUT=9
  1. I TYPE="10P"&(OUT=9) S OUT=OUT_" Proc"
  1. I TYPE="10P"&(OUT=10) S OUT=OUT_"-PCS"
  1. S RET=RET_OUT
  1. Q RET
  1. ;
  1. CODESYS(GMTSCODA,GMTSFILE) ; create coding system and label based on IEN
  1. ;input
  1. ; GMTSCODA - IEN of code in either file 80 or 80.1
  1. ; GMTSFILE - 80 or 80.1, should be able to tell based on context when this API is called
  1. ;ouput
  1. ; GMTSRET - code from 80 or 80.1 ^ coding system label
  1. ; or -1 ^ error message
  1. ; check for error condition using $P($G(GMTSRET),U)=-1 vice +$G(GMTSRET)=-1 as urnary operator
  1. ; can interpret some procedure codes as scientific notation and trigger <MAXNUMBER> error (e.g. "3E1988X").
  1. N GMTSCSYS,GMTSCODE,GMTSRET
  1. S GMTSCSYS=$$CSI^ICDEX($G(GMTSFILE),$G(GMTSCODA)) ;Coding system for IEN or NULL
  1. I $G(GMTSCSYS)="" S GMTSRET="-1^Error determining coding system" Q GMTSRET
  1. S GMTSCSYS=$$SNAM^ICDEX($G(GMTSCSYS)) ;short versioned description or -1
  1. I $G(GMTSCSYS)="-1" S GMTSRET="-1^Error determining coding system" Q GMTSRET
  1. ;
  1. S GMTSCODE=$$CODEC^ICDEX($G(GMTSFILE),$G(GMTSCODA)) ;Code from an IEN or -1^error message
  1. I $P($G(GMTSCODE),U)=-1 S GMTSRET="-1^Error: "_$P($G(GMTSCODE),U,2) Q GMTSRET
  1. S GMTSRET=$G(GMTSCODE)_U_$G(GMTSCSYS)
  1. Q GMTSRET