GMTSCNB ; SLC/KER - Consults Components Brief ; 01/06/2003
;;2.7;Health Summary;**46,47,58**;Oct 20, 1995
;
; External References
; DBIA 3358 ^GMR(123,
; DBIA 10040 ^SC(
; DBIA 10104 $$UP^XLFSTR
; DBIA 2056 $$GET1^DIQ (file 123.1, 44)
; DBIA 2056 GETS^DIQ (file 123)
; DBIA 2051 LIST^DIC (file 123.02)
;
Q
MAIN ; Consults - Brief
K ^TMP("GMTSCN")
N GMTSMAX,GMTSNMC,GMTSI,GMTSDFN S GMTSDFN=+($G(DFN))
S:'$L($G(GMTS1)) GMTS1=6666666 S:'$L($G(GMTS2)) GMTS2=9999999
S GMTS1=+($G(GMTS1)),GMTS2=+($G(GMTS2)),GMTSMAX=+($G(GMTSNDM)) S:GMTSMAX'>0 GMTSMAX=999999999
S GMTSDFN=+($G(GMTSDFN)) Q:GMTSDFN=0 Q:'$D(^GMR(123,"AD",GMTSDFN))
S:GMTS2>GMTS1 GMTSI=GMTS1,GMTS1=GMTS2,GMTS2=GMTSI S GMTSI=GMTS2-.00000001
F S GMTSI=$O(^GMR(123,"AD",GMTSDFN,GMTSI)) Q:+GMTSI=0!(GMTSI>GMTS1) D Q:$D(GMTSQIT)
. S GMTSIEN=0 F S GMTSIEN=$O(^GMR(123,"AD",GMTSDFN,GMTSI,GMTSIEN)) Q:+GMTSIEN=0 D Q:$D(GMTSQIT)
. . Q:+($G(GMTSNMC))>+($G(GMTSMAX)) K ^TMP("GMTSCN",$J)
. . D EXT(GMTSIEN,GMTSI) Q:$D(GMTSQIT) D BCD Q:$D(GMTSQIT)
Q
BCD ; Brief Consults Display
Q:'$D(^TMP("GMTSCN",$J)) S GMTSNMC=+($G(GMTSNMC))+1
D:GMTSNMC=1 BHDR Q:$D(GMTSQIT)
N GMTSID,GMTSFI,GMTSIE S GMTSID=0
F S GMTSID=$O(^TMP("GMTSCN",$J,GMTSID)) Q:+GMTSID=0 D Q:$D(GMTSQIT)
. S GMTSFI=123,GMTSIE="" F S GMTSIE=$O(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE)) Q:GMTSIE="" D Q:$D(GMTSQIT)
. . N GMTSNB,GMTSRD,GMTSTO,GMTSVC,GMTSFM,GMTSLA,GMTSAD
. . S GMTSNB=+($G(GMTSIE)) S:+GMTSNB=0 GMTSNB="?"
. . S GMTSRD=$G(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE,3,"I"))
. . S GMTSRD=$$UP^XLFSTR($S(+GMTSRD>0:$$ED^GMTSU(+GMTSRD),1:"UNKNOWN"))
. . S GMTSFM=$$UP^XLFSTR($G(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE,2,"E")))
. . S GMTSTO=$$UP^XLFSTR($G(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE,1,"E")))
. . S GMTSLA=$$UP^XLFSTR($G(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE,40,1,1,"E")))
. . S GMTSLD=$G(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE,40,1,2,"I"))
. . S GMTSLD=$$UP^XLFSTR($S(+GMTSLD>0:$$ED^GMTSU(+GMTSLD),1:"UNKNOWN"))
. . D WRT
Q
BHDR ; Brief Header
N GMTSL S $P(GMTSL,"-",79)=""
D CKP^GMTSUP Q:$D(GMTSQIT) W !,"Request Date/",?15,"Request From"
D CKP^GMTSUP Q:$D(GMTSQIT) W !,"Number",?15,"Request To",?52,"Last Action",?67,"Action Date"
D CKP^GMTSUP Q:$D(GMTSQIT) W !,GMTSL
Q
WRT ; Write Brief Consult
D CKP^GMTSUP Q:$D(GMTSQIT) W !,$E(GMTSRD,1,10),?15,GMTSFM,?52,GMTSLA,?67,GMTSLD
D CKP^GMTSUP Q:$D(GMTSQIT) W !,GMTSNB,?15,GMTSTO
D CKP^GMTSUP Q:$D(GMTSQIT) W !
Q
EXT(X,Y) ; Extract Consults
K ^TMP("GMTSCN",$J),^UTILITY("DIQ1",$J) N DIC,DIQ,DR,GMTSFM,GMTSI
N GMTSIEN,GMTSIENS,GMTSLA,GMTSRT,GMTSTY,GMTSVC
S GMTSIEN=+($G(X)) Q:GMTSIEN=0 S GMTSI=+($G(Y))
S DIC=123,GMTSIENS=+($G(GMTSIEN))_","
S GMTSRT="^TMP(""GMTSCN"","_$J_","_GMTSI_")"
S DIQ(0)="IE",DR=".01;1;2;3;9" D GETS^DIQ(123,GMTSIENS,DR,"EI",GMTSRT,"MSG")
S GMTSFM=+($G(^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,2,"I"))) S:+GMTSFM=0 GMTSFM=""
S GMTSVC="" S:+GMTSFM>0 GMTSVC=$$GET1^DIQ(44,GMTSFM,9,"E") S:$G(GMTSVC)="NONE" GMTSVC=""
S:$L(GMTSVC) ^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,2,"SVC")=GMTSVC
S GMTSTY="" S:+GMTSFM>0 GMTSTY=$$GET1^DIQ(44,GMTSFM,2,"E")
S GMTSFM=$$FM(($G(^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,2,"E"))_"^"_GMTSTY_"^"_GMTSVC))
S ^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,2,"E")=GMTSFM
S GMTSLA=+($G(^TMP("GMTSCN",$J,GMTSI,DIC,GMTSIENS,9,"I")))
S:+GMTSLA'>9 ^TMP("GMTSCN",$J,GMTSI,DIC,GMTSIENS,9,"E")=""
I +GMTSLA>0 D
. S GMTSLA=$$GET1^DIQ(123.1,GMTSLA,7,"E")
. S ^TMP("GMTSCN",$J,GMTSI,DIC,GMTSIENS,9,"E")=GMTSLA
S ^TMP("GMTSCN",$J,GMTSI,DIC,GMTSIENS,0)=(9999999-GMTSI)_"^"_$S(GMTSI>0:$$EDT^GMTSU((9999999-GMTSI)),1:"")
D ACT
Q
FM(X) ; From Service/Ward
S X=$G(X) N GMTSTY,GMTSV S GMTSTY=$P(X,"^",2),GMTSV=$P(X,"^",3),X=$P(X,"^",1)
I $L(X) S:+X>0&(GMTSTY="WARD")&(X'["WARD") X="WARD "_X S:+X'>0&(GMTSTY="WARD")&(X'["WARD") X=X_" WARD"
S:($L(X)+$L(GMTSV)+3)'>30&($L(GMTSV))&(X'[GMTSV) X=X_" ("_GMTSV_")"
S X=$$UP^XLFSTR(X)
Q X
ACT ; Activity
N GMTSL,GMTSFL,GMTSFLA,GMTSFLD,GMTSLA,GMTSLD,GMTSLR,GMTSAM,GMTSLM,GMTSC,GMTSDI,Y,DR,GMTSIENL,GMTSIENS,GMTSMSG K ^TMP("DILIST",$J)
S GMTSIENS=+GMTSIEN_",",GMTSIENL=","_GMTSIENS,DR="1I;2I;9;10"
D LIST^DIC(123.02,GMTSIENL,DR,,"*",,,,,,.GMTSDI,"GMTSMSG")
K:+($G(^TMP("DILIST",$J,0)))=0 ^TMP("DILIST",$J) Q:+($G(^TMP("DILIST",$J,0)))=0
S GMTSLA="",GMTSLD=0,GMTSLR="",GMTSAM="",GMTSC=0
S GMTSL=0
F S GMTSL=$O(^TMP("DILIST",$J,"ID",GMTSL)) Q:+GMTSL=0 D
. I +($G(^TMP("DILIST",$J,"ID",GMTSL,2)))'<GMTSLD,+($G(^TMP("DILIST",$J,"ID",GMTSL,2)))>0 D
. . S GMTSLA=+($G(^TMP("DILIST",$J,"ID",GMTSL,1)))
. . S GMTSLD=+($G(^TMP("DILIST",$J,"ID",GMTSL,2)))
. . S GMTSLR=$G(^TMP("DILIST",$J,"ID",GMTSL,9))
. . S GMTSLM=$G(^TMP("DILIST",$J,"ID",GMTSL,10))
I +($G(GMTSFLA))>0,+($G(GMTSFLD))>0,+($G(GMTSFL))>0,+($G(GMTSR))'>0 S GMTSC=0,GMTSLA=GMTSFLA,GMTSLD=GMTSFLA D AAC
I GMTSLA>0,GMTSLD>0 S GMTSC=1 D AAC
K ^TMP("DILIST",$J)
Q
AAC ; Add Activity
N GMTSEA,GMTSEP,GMTSEL,GMTSOR,GMTSW,I S GMTSC=+($G(GMTSC))
S GMTSOR=$$UP^XLFSTR($$GET1^DIQ(123.1,GMTSLA,1,"I"))
S GMTSEP=$$UP^XLFSTR($$GET1^DIQ(123.1,GMTSLA,7,"E"))
S GMTSEA=$$UP^XLFSTR($$GET1^DIQ(123.1,GMTSLA,.01,"E"))
S GMTSEL=$$AL(GMTSEA,GMTSEP) Q:'$L(GMTSEL)
S GMTSEA=$$AN(GMTSEA,GMTSEP) Q:'$L(GMTSEA)
I GMTSC>0 D
. S ^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,GMTSC,1,"I")=GMTSLA,^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,GMTSC,1,"E")=GMTSEA,^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,GMTSC,1,"L")=GMTSEL
. S ^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,GMTSC,2,"I")=GMTSLD,^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,GMTSC,2,"E")=$$EDT^GMTSU(GMTSLD)
I GMTSC'>0 D
. S ^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,"LA","I")=GMTSLA,^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,"LA","E")=GMTSEA,^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,"LA","L")=GMTSEL
. S ^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,"LD","I")=GMTSLD,^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,"LD","E")=$$EDT^GMTSU(GMTSLD)
. S ^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,"WR","E")=$G(^TMP("DILIST",$J,"ID",GMTSFL,3))
Q
AN(X,Y) ; Activity Name
N GMTSW,GMTSP,GMTSA S GMTSA=$G(X),GMTSP=$G(Y) S X=$$SN((GMTSA_" "_GMTSP)) S X=$E(X,1,11) Q X
AL(X,Y) ; Activity Name
N GMTSP,GMTSA S GMTSA=$G(X),GMTSP=$G(Y) S:GMTSA["RECEIVE" (GMTSA,GMTSP)="RECEIVED"
S:GMTSA="ENTERED IN CPRS"!(GMTSA["CPRS RELEASED") (GMTSA,GMTSP)="DATA ENTRY" S:GMTSA="EDIT BEFORE RELEASE" (GMTSA,GMTSP)="EDITED"
S X="" S:$L(GMTSA)&($L(GMTSP)) X=$S($L(GMTSP)>$L(GMTSA):GMTSP,1:GMTSA) S:'$L(GMTSA)!('$L(GMTSP)) X=$S('$L(GMTSP)&($L(GMTSA)):GMTSA,$L(GMTSP)&('$L(GMTSA)):GMTSP,1:"")
Q X
SN(X) ;
S X=$G(X) Q:X="" "UNKNOWN" Q:X["ENTERED"!(X["RELEASED") "ENTERED" Q:X["STATUS" "STAT CHG"
Q:X["SIGNIF" "SIG FIND" Q:X["DISCONT" "DISCONT'D" Q:X["SCHEDUL" "SCHEDULED" Q:X["INCOMPL" "INCOMPLETE" Q:X["COMPLET" "COMPLETE"
Q:X["EDIT" "EDITED" Q:X["DISASSO" "DISASSOC'D" Q:X["ADDENDUM" "ADDENDUM" Q:X["NEW NOTE" "NEW NOTE"
Q:X["SERVICE" "SVC ENTER" Q:X["FORWARD" "FORWARDED" Q:X["CANCELLED" "CANCELLED" Q:X["COMMENT" "COMMENT" Q:X["RECEIVED" "RECEIVED" Q:X["PRINTED" "PRINTED"
Q "UNKNOWN"
GMTSCNB ; SLC/KER - Consults Components Brief ; 01/06/2003
+1 ;;2.7;Health Summary;**46,47,58**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 3358 ^GMR(123,
+5 ; DBIA 10040 ^SC(
+6 ; DBIA 10104 $$UP^XLFSTR
+7 ; DBIA 2056 $$GET1^DIQ (file 123.1, 44)
+8 ; DBIA 2056 GETS^DIQ (file 123)
+9 ; DBIA 2051 LIST^DIC (file 123.02)
+10 ;
+11 QUIT
MAIN ; Consults - Brief
+1 KILL ^TMP("GMTSCN")
+2 NEW GMTSMAX,GMTSNMC,GMTSI,GMTSDFN
SET GMTSDFN=+($GET(DFN))
+3 IF '$LENGTH($GET(GMTS1))
SET GMTS1=6666666
IF '$LENGTH($GET(GMTS2))
SET GMTS2=9999999
+4 SET GMTS1=+($GET(GMTS1))
SET GMTS2=+($GET(GMTS2))
SET GMTSMAX=+($GET(GMTSNDM))
IF GMTSMAX'>0
SET GMTSMAX=999999999
+5 SET GMTSDFN=+($GET(GMTSDFN))
IF GMTSDFN=0
QUIT
IF '$DATA(^GMR(123,"AD",GMTSDFN))
QUIT
+6 IF GMTS2>GMTS1
SET GMTSI=GMTS1
SET GMTS1=GMTS2
SET GMTS2=GMTSI
SET GMTSI=GMTS2-.00000001
+7 FOR
SET GMTSI=$ORDER(^GMR(123,"AD",GMTSDFN,GMTSI))
IF +GMTSI=0!(GMTSI>GMTS1)
QUIT
Begin DoDot:1
+8 SET GMTSIEN=0
FOR
SET GMTSIEN=$ORDER(^GMR(123,"AD",GMTSDFN,GMTSI,GMTSIEN))
IF +GMTSIEN=0
QUIT
Begin DoDot:2
+9 IF +($GET(GMTSNMC))>+($GET(GMTSMAX))
QUIT
KILL ^TMP("GMTSCN",$JOB)
+10 DO EXT(GMTSIEN,GMTSI)
IF $DATA(GMTSQIT)
QUIT
DO BCD
IF $DATA(GMTSQIT)
QUIT
End DoDot:2
IF $DATA(GMTSQIT)
QUIT
End DoDot:1
IF $DATA(GMTSQIT)
QUIT
+11 QUIT
BCD ; Brief Consults Display
+1 IF '$DATA(^TMP("GMTSCN",$JOB))
QUIT
SET GMTSNMC=+($GET(GMTSNMC))+1
+2 IF GMTSNMC=1
DO BHDR
IF $DATA(GMTSQIT)
QUIT
+3 NEW GMTSID,GMTSFI,GMTSIE
SET GMTSID=0
+4 FOR
SET GMTSID=$ORDER(^TMP("GMTSCN",$JOB,GMTSID))
IF +GMTSID=0
QUIT
Begin DoDot:1
+5 SET GMTSFI=123
SET GMTSIE=""
FOR
SET GMTSIE=$ORDER(^TMP("GMTSCN",$JOB,GMTSID,GMTSFI,GMTSIE))
IF GMTSIE=""
QUIT
Begin DoDot:2
+6 NEW GMTSNB,GMTSRD,GMTSTO,GMTSVC,GMTSFM,GMTSLA,GMTSAD
+7 SET GMTSNB=+($GET(GMTSIE))
IF +GMTSNB=0
SET GMTSNB="?"
+8 SET GMTSRD=$GET(^TMP("GMTSCN",$JOB,GMTSID,GMTSFI,GMTSIE,3,"I"))
+9 SET GMTSRD=$$UP^XLFSTR($SELECT(+GMTSRD>0:$$ED^GMTSU(+GMTSRD),1:"UNKNOWN"))
+10 SET GMTSFM=$$UP^XLFSTR($GET(^TMP("GMTSCN",$JOB,GMTSID,GMTSFI,GMTSIE,2,"E")))
+11 SET GMTSTO=$$UP^XLFSTR($GET(^TMP("GMTSCN",$JOB,GMTSID,GMTSFI,GMTSIE,1,"E")))
+12 SET GMTSLA=$$UP^XLFSTR($GET(^TMP("GMTSCN",$JOB,GMTSID,GMTSFI,GMTSIE,40,1,1,"E")))
+13 SET GMTSLD=$GET(^TMP("GMTSCN",$JOB,GMTSID,GMTSFI,GMTSIE,40,1,2,"I"))
+14 SET GMTSLD=$$UP^XLFSTR($SELECT(+GMTSLD>0:$$ED^GMTSU(+GMTSLD),1:"UNKNOWN"))
+15 DO WRT
End DoDot:2
IF $DATA(GMTSQIT)
QUIT
End DoDot:1
IF $DATA(GMTSQIT)
QUIT
+16 QUIT
BHDR ; Brief Header
+1 NEW GMTSL
SET $PIECE(GMTSL,"-",79)=""
+2 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE !,"Request Date/",?15,"Request From"
+3 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE !,"Number",?15,"Request To",?52,"Last Action",?67,"Action Date"
+4 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE !,GMTSL
+5 QUIT
WRT ; Write Brief Consult
+1 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE !,$EXTRACT(GMTSRD,1,10),?15,GMTSFM,?52,GMTSLA,?67,GMTSLD
+2 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE !,GMTSNB,?15,GMTSTO
+3 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE !
+4 QUIT
EXT(X,Y) ; Extract Consults
+1 KILL ^TMP("GMTSCN",$JOB),^UTILITY("DIQ1",$JOB)
NEW DIC,DIQ,DR,GMTSFM,GMTSI
+2 NEW GMTSIEN,GMTSIENS,GMTSLA,GMTSRT,GMTSTY,GMTSVC
+3 SET GMTSIEN=+($GET(X))
IF GMTSIEN=0
QUIT
SET GMTSI=+($GET(Y))
+4 SET DIC=123
SET GMTSIENS=+($GET(GMTSIEN))_","
+5 SET GMTSRT="^TMP(""GMTSCN"","_$JOB_","_GMTSI_")"
+6 SET DIQ(0)="IE"
SET DR=".01;1;2;3;9"
DO GETS^DIQ(123,GMTSIENS,DR,"EI",GMTSRT,"MSG")
+7 SET GMTSFM=+($GET(^TMP("GMTSCN",$JOB,GMTSI,123,GMTSIENS,2,"I")))
IF +GMTSFM=0
SET GMTSFM=""
+8 SET GMTSVC=""
IF +GMTSFM>0
SET GMTSVC=$$GET1^DIQ(44,GMTSFM,9,"E")
IF $GET(GMTSVC)="NONE"
SET GMTSVC=""
+9 IF $LENGTH(GMTSVC)
SET ^TMP("GMTSCN",$JOB,GMTSI,123,GMTSIENS,2,"SVC")=GMTSVC
+10 SET GMTSTY=""
IF +GMTSFM>0
SET GMTSTY=$$GET1^DIQ(44,GMTSFM,2,"E")
+11 SET GMTSFM=$$FM(($GET(^TMP("GMTSCN",$JOB,GMTSI,123,GMTSIENS,2,"E"))_"^"_GMTSTY_"^"_GMTSVC))
+12 SET ^TMP("GMTSCN",$JOB,GMTSI,123,GMTSIENS,2,"E")=GMTSFM
+13 SET GMTSLA=+($GET(^TMP("GMTSCN",$JOB,GMTSI,DIC,GMTSIENS,9,"I")))
+14 IF +GMTSLA'>9
SET ^TMP("GMTSCN",$JOB,GMTSI,DIC,GMTSIENS,9,"E")=""
+15 IF +GMTSLA>0
Begin DoDot:1
+16 SET GMTSLA=$$GET1^DIQ(123.1,GMTSLA,7,"E")
+17 SET ^TMP("GMTSCN",$JOB,GMTSI,DIC,GMTSIENS,9,"E")=GMTSLA
End DoDot:1
+18 SET ^TMP("GMTSCN",$JOB,GMTSI,DIC,GMTSIENS,0)=(9999999-GMTSI)_"^"_$SELECT(GMTSI>0:$$EDT^GMTSU((9999999-GMTSI)),1:"")
+19 DO ACT
+20 QUIT
FM(X) ; From Service/Ward
+1 SET X=$GET(X)
NEW GMTSTY,GMTSV
SET GMTSTY=$PIECE(X,"^",2)
SET GMTSV=$PIECE(X,"^",3)
SET X=$PIECE(X,"^",1)
+2 IF $LENGTH(X)
IF +X>0&(GMTSTY="WARD")&(X'["WARD")
SET X="WARD "_X
IF +X'>0&(GMTSTY="WARD")&(X'["WARD")
SET X=X_" WARD"
+3 IF ($LENGTH(X)+$LENGTH(GMTSV)+3)'>30&($LENGTH(GMTSV))&(X'[GMTSV)
SET X=X_" ("_GMTSV_")"
+4 SET X=$$UP^XLFSTR(X)
+5 QUIT X
ACT ; Activity
+1 NEW GMTSL,GMTSFL,GMTSFLA,GMTSFLD,GMTSLA,GMTSLD,GMTSLR,GMTSAM,GMTSLM,GMTSC,GMTSDI,Y,DR,GMTSIENL,GMTSIENS,GMTSMSG
KILL ^TMP("DILIST",$JOB)
+2 SET GMTSIENS=+GMTSIEN_","
SET GMTSIENL=","_GMTSIENS
SET DR="1I;2I;9;10"
+3 DO LIST^DIC(123.02,GMTSIENL,DR,,"*",,,,,,.GMTSDI,"GMTSMSG")
+4 IF +($GET(^TMP("DILIST",$JOB,0)))=0
KILL ^TMP("DILIST",$JOB)
IF +($GET(^TMP("DILIST",$JOB,0)))=0
QUIT
+5 SET GMTSLA=""
SET GMTSLD=0
SET GMTSLR=""
SET GMTSAM=""
SET GMTSC=0
+6 SET GMTSL=0
+7 FOR
SET GMTSL=$ORDER(^TMP("DILIST",$JOB,"ID",GMTSL))
IF +GMTSL=0
QUIT
Begin DoDot:1
+8 IF +($GET(^TMP("DILIST",$JOB,"ID",GMTSL,2)))'<GMTSLD
IF +($GET(^TMP("DILIST",$JOB,"ID",GMTSL,2)))>0
Begin DoDot:2
+9 SET GMTSLA=+($GET(^TMP("DILIST",$JOB,"ID",GMTSL,1)))
+10 SET GMTSLD=+($GET(^TMP("DILIST",$JOB,"ID",GMTSL,2)))
+11 SET GMTSLR=$GET(^TMP("DILIST",$JOB,"ID",GMTSL,9))
+12 SET GMTSLM=$GET(^TMP("DILIST",$JOB,"ID",GMTSL,10))
End DoDot:2
End DoDot:1
+13 IF +($GET(GMTSFLA))>0
IF +($GET(GMTSFLD))>0
IF +($GET(GMTSFL))>0
IF +($GET(GMTSR))'>0
SET GMTSC=0
SET GMTSLA=GMTSFLA
SET GMTSLD=GMTSFLA
DO AAC
+14 IF GMTSLA>0
IF GMTSLD>0
SET GMTSC=1
DO AAC
+15 KILL ^TMP("DILIST",$JOB)
+16 QUIT
AAC ; Add Activity
+1 NEW GMTSEA,GMTSEP,GMTSEL,GMTSOR,GMTSW,I
SET GMTSC=+($GET(GMTSC))
+2 SET GMTSOR=$$UP^XLFSTR($$GET1^DIQ(123.1,GMTSLA,1,"I"))
+3 SET GMTSEP=$$UP^XLFSTR($$GET1^DIQ(123.1,GMTSLA,7,"E"))
+4 SET GMTSEA=$$UP^XLFSTR($$GET1^DIQ(123.1,GMTSLA,.01,"E"))
+5 SET GMTSEL=$$AL(GMTSEA,GMTSEP)
IF '$LENGTH(GMTSEL)
QUIT
+6 SET GMTSEA=$$AN(GMTSEA,GMTSEP)
IF '$LENGTH(GMTSEA)
QUIT
+7 IF GMTSC>0
Begin DoDot:1
+8 SET ^TMP("GMTSCN",$JOB,GMTSI,123,GMTSIENS,40,GMTSC,1,"I")=GMTSLA
SET ^TMP("GMTSCN",$JOB,GMTSI,123,GMTSIENS,40,GMTSC,1,"E")=GMTSEA
SET ^TMP("GMTSCN",$JOB,GMTSI,123,GMTSIENS,40,GMTSC,1,"L")=GMTSEL
+9 SET ^TMP("GMTSCN",$JOB,GMTSI,123,GMTSIENS,40,GMTSC,2,"I")=GMTSLD
SET ^TMP("GMTSCN",$JOB,GMTSI,123,GMTSIENS,40,GMTSC,2,"E")=$$EDT^GMTSU(GMTSLD)
End DoDot:1
+10 IF GMTSC'>0
Begin DoDot:1
+11 SET ^TMP("GMTSCN",$JOB,GMTSI,123,GMTSIENS,40,"LA","I")=GMTSLA
SET ^TMP("GMTSCN",$JOB,GMTSI,123,GMTSIENS,40,"LA","E")=GMTSEA
SET ^TMP("GMTSCN",$JOB,GMTSI,123,GMTSIENS,40,"LA","L")=GMTSEL
+12 SET ^TMP("GMTSCN",$JOB,GMTSI,123,GMTSIENS,40,"LD","I")=GMTSLD
SET ^TMP("GMTSCN",$JOB,GMTSI,123,GMTSIENS,40,"LD","E")=$$EDT^GMTSU(GMTSLD)
+13 SET ^TMP("GMTSCN",$JOB,GMTSI,123,GMTSIENS,40,"WR","E")=$GET(^TMP("DILIST",$JOB,"ID",GMTSFL,3))
End DoDot:1
+14 QUIT
AN(X,Y) ; Activity Name
+1 NEW GMTSW,GMTSP,GMTSA
SET GMTSA=$GET(X)
SET GMTSP=$GET(Y)
SET X=$$SN((GMTSA_" "_GMTSP))
SET X=$EXTRACT(X,1,11)
QUIT X
AL(X,Y) ; Activity Name
+1 NEW GMTSP,GMTSA
SET GMTSA=$GET(X)
SET GMTSP=$GET(Y)
IF GMTSA["RECEIVE"
SET (GMTSA,GMTSP)="RECEIVED"
+2 IF GMTSA="ENTERED IN CPRS"!(GMTSA["CPRS RELEASED")
SET (GMTSA,GMTSP)="DATA ENTRY"
IF GMTSA="EDIT BEFORE RELEASE"
SET (GMTSA,GMTSP)="EDITED"
+3 SET X=""
IF $LENGTH(GMTSA)&($LENGTH(GMTSP))
SET X=$SELECT($LENGTH(GMTSP)>$LENGTH(GMTSA):GMTSP,1:GMTSA)
IF '$LENGTH(GMTSA)!('$LENGTH(GMTSP))
SET X=$SELECT('$LENGTH(GMTSP)&($LENGTH(GMTSA)):GMTSA,$LENGTH(GMTSP)&('$LENGTH(GMTSA)):GMTSP,1:"")
+4 QUIT X
SN(X) ;
+1 SET X=$GET(X)
IF X=""
QUIT "UNKNOWN"
IF X["ENTERED"!(X["RELEASED")
QUIT "ENTERED"
IF X["STATUS"
QUIT "STAT CHG"
+2 IF X["SIGNIF"
QUIT "SIG FIND"
IF X["DISCONT"
QUIT "DISCONT'D"
IF X["SCHEDUL"
QUIT "SCHEDULED"
IF X["INCOMPL"
QUIT "INCOMPLETE"
IF X["COMPLET"
QUIT "COMPLETE"
+3 IF X["EDIT"
QUIT "EDITED"
IF X["DISASSO"
QUIT "DISASSOC'D"
IF X["ADDENDUM"
QUIT "ADDENDUM"
IF X["NEW NOTE"
QUIT "NEW NOTE"
+4 IF X["SERVICE"
QUIT "SVC ENTER"
IF X["FORWARD"
QUIT "FORWARDED"
IF X["CANCELLED"
QUIT "CANCELLED"
IF X["COMMENT"
QUIT "COMMENT"
IF X["RECEIVED"
QUIT "RECEIVED"
IF X["PRINTED"
QUIT "PRINTED"
+5 QUIT "UNKNOWN"
