- GMTSCNB ; SLC/KER - Consults Components Brief ; 5/30/17 6:35pm
- ;;2.7;Health Summary;**46,47,58,90,112,121**;Oct 20, 1995;Build 5
- ;
- ; 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)
- ;
- ; Delete this line: test of perforce/eclipse
- ;
- Q
- MAIN ; Consults - Brief
- K ^TMP("GMTSCN",$J)
- 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
- S GMTSNMC=1
- 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,GMTSED
- . . 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 GMTSED=$G(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE,17,"I"))
- . . S GMTSED=$$UP^XLFSTR($S(+GMTSED>0:$$ED^GMTSU(+GMTSED),1:"UNKNOWN"))
- . . 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",?52,"Clinically Ind. Date"
- 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,$E(GMTSED,1,10)
- D CKP^GMTSUP Q:$D(GMTSQIT) W !,GMTSNB,?15,GMTSTO,?52,GMTSLA,?67,GMTSLD
- 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;17" 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"
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSCNB 7400 printed Jan 18, 2025@02:58:21 Page 2
- GMTSCNB ; SLC/KER - Consults Components Brief ; 5/30/17 6:35pm
- +1 ;;2.7;Health Summary;**46,47,58,90,112,121**;Oct 20, 1995;Build 5
- +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 ; Delete this line: test of perforce/eclipse
- +12 ;
- +13 QUIT
- MAIN ; Consults - Brief
- +1 KILL ^TMP("GMTSCN",$JOB)
- +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 SET GMTSNMC=1
- +8 FOR
- SET GMTSI=$ORDER(^GMR(123,"AD",GMTSDFN,GMTSI))
- if +GMTSI=0!(GMTSI>GMTS1)
- QUIT
- Begin DoDot:1
- +9 SET GMTSIEN=0
- FOR
- SET GMTSIEN=$ORDER(^GMR(123,"AD",GMTSDFN,GMTSI,GMTSIEN))
- if +GMTSIEN=0
- QUIT
- Begin DoDot:2
- +10 if +($GET(GMTSNMC))>+($GET(GMTSMAX))
- QUIT
- KILL ^TMP("GMTSCN",$JOB)
- +11 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
- +12 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,GMTSED
- +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 GMTSED=$GET(^TMP("GMTSCN",$JOB,GMTSID,GMTSFI,GMTSIE,17,"I"))
- +12 SET GMTSED=$$UP^XLFSTR($SELECT(+GMTSED>0:$$ED^GMTSU(+GMTSED),1:"UNKNOWN"))
- +13 SET GMTSTO=$$UP^XLFSTR($GET(^TMP("GMTSCN",$JOB,GMTSID,GMTSFI,GMTSIE,1,"E")))
- +14 SET GMTSLA=$$UP^XLFSTR($GET(^TMP("GMTSCN",$JOB,GMTSID,GMTSFI,GMTSIE,40,1,1,"E")))
- +15 SET GMTSLD=$GET(^TMP("GMTSCN",$JOB,GMTSID,GMTSFI,GMTSIE,40,1,2,"I"))
- +16 SET GMTSLD=$$UP^XLFSTR($SELECT(+GMTSLD>0:$$ED^GMTSU(+GMTSLD),1:"UNKNOWN"))
- +17 DO WRT
- End DoDot:2
- if $DATA(GMTSQIT)
- QUIT
- End DoDot:1
- if $DATA(GMTSQIT)
- QUIT
- +18 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",?52,"Clinically Ind. Date"
- +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,$EXTRACT(GMTSED,1,10)
- +2 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE !,GMTSNB,?15,GMTSTO,?52,GMTSLA,?67,GMTSLD
- +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;17"
- 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"