GMTSPXU1 ; SLC/SBW - PCE Utilities sub-routines ;21-Jan-2014 14:19;MGH
;;2.7;Health Summary;**10,37,71,1006**;Oct 20, 1995;Build 3
;
; External References
; DBIA 3390 $$ICDDX^ICDCODE
; DBIA 3390 $$ICDOP^ICDCODE
; DBIA 3390 $$ICDD^ICDCODE
; DBIA 1995 $$CPT^ICPTCOD
; DBIA 10026 ^DIR
; DBIA 10011 ^DIWP
;Patch 1006 added new calls for ICD-10
;
GETICDDX(GMTSICD,GMTSICF,GMMOD) ; Entry point to get ICD data
N REC,CODE,NAME,DESC,ICDX,ICDI,ICDA
S GMTSICD=$G(GMTSICD),GMTSICF=$G(GMTSICF),GMMOD=$G(GMMOD)
I $$AICD^BHSUTL S ICDX=$$ICDDX^ICDEX(+GMTSICD)
E S ICDX=$$ICDDX^ICDCODE(+GMTSICD)
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)
I $$AICD^BHSUTL S ICDI=$$ICDD^ICDEX($P(ICDX,"^",2),"ICDA")
S ICDI=$$ICDD^ICDCODE($P(ICDX,"^",2),"ICDA")
S REC(80,GMTSICD,10,"E")=$G(ICDA(1))
S REC(80,GMTSICD,10,"I")=$G(ICDA(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="") GMTSICD=CODE_"-"_DESC
S:GMTSICF="S" GMTSICD=CODE_"-"_NAME
S:GMTSICF="C" GMTSICD=CODE
S:GMTSICF="T" GMTSICD=DESC
I $G(GMMOD)]"" S GMMOD=$P(GMMOD,","),GMTSICD=GMMOD_" "_GMTSICD
S:GMTSICF="N" GMTSICD=""
Q
;
GETICDOP(GMTSICD,GMTSICF,GMMOD) ; Entry point to get ICD0 data
S GMTSICD=$G(GMTSICD),GMTSICF=$G(GMTSICF),GMMOD=$G(GMMOD)
N REC,CODE,NAME,DESC,ICDX,ICDI,ICDA
I $$AICD^BHSUTL S ICDX=$$ICDOP^ICDEX(+GMTSICD)
E S ICDX=$$ICDOP^ICDCODE(+GMTSICD)
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)
I $$AICD^BHSUTL S ICDI=$$ICDD^ICDEX($P(ICDX,"^",2),"ICDA")
E S ICDI=$$ICDD^ICDCODE($P(ICDX,"^",2),"ICDA")
S REC(80.1,GMTSICD,10,"E")=$G(ICDA(1))
S REC(80.1,GMTSICD,10,"I")=$G(ICDA(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")
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
GMTSPXU1 ; SLC/SBW - PCE Utilities sub-routines ;21-Jan-2014 14:19;MGH
+1 ;;2.7;Health Summary;**10,37,71,1006**;Oct 20, 1995;Build 3
+2 ;
+3 ; External References
+4 ; DBIA 3390 $$ICDDX^ICDCODE
+5 ; DBIA 3390 $$ICDOP^ICDCODE
+6 ; DBIA 3390 $$ICDD^ICDCODE
+7 ; DBIA 1995 $$CPT^ICPTCOD
+8 ; DBIA 10026 ^DIR
+9 ; DBIA 10011 ^DIWP
+10 ;Patch 1006 added new calls for ICD-10
+11 ;
GETICDDX(GMTSICD,GMTSICF,GMMOD) ; Entry point to get ICD data
+1 NEW REC,CODE,NAME,DESC,ICDX,ICDI,ICDA
+2 SET GMTSICD=$GET(GMTSICD)
SET GMTSICF=$GET(GMTSICF)
SET GMMOD=$GET(GMMOD)
+3 IF $$AICD^BHSUTL
SET ICDX=$$ICDDX^ICDEX(+GMTSICD)
+4 IF '$TEST
SET ICDX=$$ICDDX^ICDCODE(+GMTSICD)
+5 SET REC(80,GMTSICD,.01,"E")=$PIECE(ICDX,"^",2)
+6 SET REC(80,GMTSICD,.01,"I")=$PIECE(ICDX,"^",2)
+7 SET REC(80,GMTSICD,3,"E")=$PIECE(ICDX,"^",4)
+8 SET REC(80,GMTSICD,3,"I")=$PIECE(ICDX,"^",4)
+9 IF $$AICD^BHSUTL
SET ICDI=$$ICDD^ICDEX($PIECE(ICDX,"^",2),"ICDA")
+10 SET ICDI=$$ICDD^ICDCODE($PIECE(ICDX,"^",2),"ICDA")
+11 SET REC(80,GMTSICD,10,"E")=$GET(ICDA(1))
+12 SET REC(80,GMTSICD,10,"I")=$GET(ICDA(1))
+13 SET CODE=REC(80,GMTSICD,.01,"I")
+14 SET NAME=REC(80,GMTSICD,3,"E")
+15 SET DESC=REC(80,GMTSICD,10,"E")
+16 IF GMTSICF="L"!(GMTSICF="")
SET GMTSICD=CODE_"-"_DESC
+17 IF GMTSICF="S"
SET GMTSICD=CODE_"-"_NAME
+18 IF GMTSICF="C"
SET GMTSICD=CODE
+19 IF GMTSICF="T"
SET GMTSICD=DESC
+20 IF $GET(GMMOD)]""
SET GMMOD=$PIECE(GMMOD,",")
SET GMTSICD=GMMOD_" "_GMTSICD
+21 IF GMTSICF="N"
SET GMTSICD=""
+22 QUIT
+23 ;
GETICDOP(GMTSICD,GMTSICF,GMMOD) ; Entry point to get ICD0 data
+1 SET GMTSICD=$GET(GMTSICD)
SET GMTSICF=$GET(GMTSICF)
SET GMMOD=$GET(GMMOD)
+2 NEW REC,CODE,NAME,DESC,ICDX,ICDI,ICDA
+3 IF $$AICD^BHSUTL
SET ICDX=$$ICDOP^ICDEX(+GMTSICD)
+4 IF '$TEST
SET ICDX=$$ICDOP^ICDCODE(+GMTSICD)
+5 SET REC(80.1,GMTSICD,.01,"E")=$PIECE(ICDX,"^",2)
+6 SET REC(80.1,GMTSICD,.01,"I")=$PIECE(ICDX,"^",2)
+7 SET REC(80.1,GMTSICD,4,"E")=$PIECE(ICDX,"^",5)
+8 SET REC(80.1,GMTSICD,4,"I")=$PIECE(ICDX,"^",5)
+9 IF $$AICD^BHSUTL
SET ICDI=$$ICDD^ICDEX($PIECE(ICDX,"^",2),"ICDA")
+10 IF '$TEST
SET ICDI=$$ICDD^ICDCODE($PIECE(ICDX,"^",2),"ICDA")
+11 SET REC(80.1,GMTSICD,10,"E")=$GET(ICDA(1))
+12 SET REC(80.1,GMTSICD,10,"I")=$GET(ICDA(1))
+13 SET CODE=REC(80.1,GMTSICD,.01,"I")
+14 SET NAME=REC(80.1,GMTSICD,4,"E")
+15 SET DESC=REC(80.1,GMTSICD,10,"E")
+16 IF GMTSICF="L"!(GMTSICF="")
SET GMTSICD=CODE_"-"_DESC
+17 IF GMTSICF="S"
SET GMTSICD=CODE_"-"_NAME
+18 IF GMTSICF="C"
SET GMTSICD=CODE
+19 IF GMTSICF="T"
SET GMTSICD=DESC
+20 IF GMTSICF="N"
SET GMTSICD=""
+21 QUIT
+22 ;
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
