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

GMTSCNB.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; External References
  1. ; DBIA 3358 ^GMR(123,
  1. ; DBIA 10040 ^SC(
  1. ; DBIA 10104 $$UP^XLFSTR
  1. ; DBIA 2056 $$GET1^DIQ (file 123.1, 44)
  1. ; DBIA 2056 GETS^DIQ (file 123)
  1. ; DBIA 2051 LIST^DIC (file 123.02)
  1. ;
  1. ; Delete this line: test of perforce/eclipse
  1. ;
  1. Q
  1. MAIN ; Consults - Brief
  1. K ^TMP("GMTSCN",$J)
  1. N GMTSMAX,GMTSNMC,GMTSI,GMTSDFN S GMTSDFN=+($G(DFN))
  1. S:'$L($G(GMTS1)) GMTS1=6666666 S:'$L($G(GMTS2)) GMTS2=9999999
  1. S GMTS1=+($G(GMTS1)),GMTS2=+($G(GMTS2)),GMTSMAX=+($G(GMTSNDM)) S:GMTSMAX'>0 GMTSMAX=999999999
  1. S GMTSDFN=+($G(GMTSDFN)) Q:GMTSDFN=0 Q:'$D(^GMR(123,"AD",GMTSDFN))
  1. S:GMTS2>GMTS1 GMTSI=GMTS1,GMTS1=GMTS2,GMTS2=GMTSI S GMTSI=GMTS2-.00000001
  1. S GMTSNMC=1
  1. F S GMTSI=$O(^GMR(123,"AD",GMTSDFN,GMTSI)) Q:+GMTSI=0!(GMTSI>GMTS1) D Q:$D(GMTSQIT)
  1. . S GMTSIEN=0 F S GMTSIEN=$O(^GMR(123,"AD",GMTSDFN,GMTSI,GMTSIEN)) Q:+GMTSIEN=0 D Q:$D(GMTSQIT)
  1. . . Q:+($G(GMTSNMC))>+($G(GMTSMAX)) K ^TMP("GMTSCN",$J)
  1. . . D EXT(GMTSIEN,GMTSI) Q:$D(GMTSQIT) D BCD Q:$D(GMTSQIT)
  1. Q
  1. BCD ; Brief Consults Display
  1. Q:'$D(^TMP("GMTSCN",$J)) S GMTSNMC=+($G(GMTSNMC))+1
  1. D:GMTSNMC=1 BHDR Q:$D(GMTSQIT)
  1. N GMTSID,GMTSFI,GMTSIE S GMTSID=0
  1. F S GMTSID=$O(^TMP("GMTSCN",$J,GMTSID)) Q:+GMTSID=0 D Q:$D(GMTSQIT)
  1. . S GMTSFI=123,GMTSIE="" F S GMTSIE=$O(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE)) Q:GMTSIE="" D Q:$D(GMTSQIT)
  1. . . N GMTSNB,GMTSRD,GMTSTO,GMTSVC,GMTSFM,GMTSLA,GMTSAD,GMTSED
  1. . . S GMTSNB=+($G(GMTSIE)) S:+GMTSNB=0 GMTSNB="?"
  1. . . S GMTSRD=$G(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE,3,"I"))
  1. . . S GMTSRD=$$UP^XLFSTR($S(+GMTSRD>0:$$ED^GMTSU(+GMTSRD),1:"UNKNOWN"))
  1. . . S GMTSFM=$$UP^XLFSTR($G(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE,2,"E")))
  1. . . S GMTSED=$G(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE,17,"I"))
  1. . . S GMTSED=$$UP^XLFSTR($S(+GMTSED>0:$$ED^GMTSU(+GMTSED),1:"UNKNOWN"))
  1. . . S GMTSTO=$$UP^XLFSTR($G(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE,1,"E")))
  1. . . S GMTSLA=$$UP^XLFSTR($G(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE,40,1,1,"E")))
  1. . . S GMTSLD=$G(^TMP("GMTSCN",$J,GMTSID,GMTSFI,GMTSIE,40,1,2,"I"))
  1. . . S GMTSLD=$$UP^XLFSTR($S(+GMTSLD>0:$$ED^GMTSU(+GMTSLD),1:"UNKNOWN"))
  1. . . D WRT
  1. Q
  1. BHDR ; Brief Header
  1. N GMTSL S $P(GMTSL,"-",79)=""
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W !,"Request Date/",?15,"Request From",?52,"Clinically Ind. Date"
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W !,"Number",?15,"Request To",?52,"Last Action",?67,"Action Date"
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W !,GMTSL
  1. Q
  1. WRT ; Write Brief Consult
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W !,$E(GMTSRD,1,10),?15,GMTSFM,?52,$E(GMTSED,1,10)
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W !,GMTSNB,?15,GMTSTO,?52,GMTSLA,?67,GMTSLD
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W !
  1. Q
  1. EXT(X,Y) ; Extract Consults
  1. K ^TMP("GMTSCN",$J),^UTILITY("DIQ1",$J) N DIC,DIQ,DR,GMTSFM,GMTSI
  1. N GMTSIEN,GMTSIENS,GMTSLA,GMTSRT,GMTSTY,GMTSVC
  1. S GMTSIEN=+($G(X)) Q:GMTSIEN=0 S GMTSI=+($G(Y))
  1. S DIC=123,GMTSIENS=+($G(GMTSIEN))_","
  1. S GMTSRT="^TMP(""GMTSCN"","_$J_","_GMTSI_")"
  1. S DIQ(0)="IE",DR=".01;1;2;3;9;17" D GETS^DIQ(123,GMTSIENS,DR,"EI",GMTSRT,"MSG")
  1. S GMTSFM=+($G(^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,2,"I"))) S:+GMTSFM=0 GMTSFM=""
  1. S GMTSVC="" S:+GMTSFM>0 GMTSVC=$$GET1^DIQ(44,GMTSFM,9,"E") S:$G(GMTSVC)="NONE" GMTSVC=""
  1. S:$L(GMTSVC) ^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,2,"SVC")=GMTSVC
  1. S GMTSTY="" S:+GMTSFM>0 GMTSTY=$$GET1^DIQ(44,GMTSFM,2,"E")
  1. S GMTSFM=$$FM(($G(^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,2,"E"))_"^"_GMTSTY_"^"_GMTSVC))
  1. S ^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,2,"E")=GMTSFM
  1. S GMTSLA=+($G(^TMP("GMTSCN",$J,GMTSI,DIC,GMTSIENS,9,"I")))
  1. S:+GMTSLA'>9 ^TMP("GMTSCN",$J,GMTSI,DIC,GMTSIENS,9,"E")=""
  1. I +GMTSLA>0 D
  1. . S GMTSLA=$$GET1^DIQ(123.1,GMTSLA,7,"E")
  1. . S ^TMP("GMTSCN",$J,GMTSI,DIC,GMTSIENS,9,"E")=GMTSLA
  1. S ^TMP("GMTSCN",$J,GMTSI,DIC,GMTSIENS,0)=(9999999-GMTSI)_"^"_$S(GMTSI>0:$$EDT^GMTSU((9999999-GMTSI)),1:"")
  1. D ACT
  1. Q
  1. FM(X) ; From Service/Ward
  1. S X=$G(X) N GMTSTY,GMTSV S GMTSTY=$P(X,"^",2),GMTSV=$P(X,"^",3),X=$P(X,"^",1)
  1. I $L(X) S:+X>0&(GMTSTY="WARD")&(X'["WARD") X="WARD "_X S:+X'>0&(GMTSTY="WARD")&(X'["WARD") X=X_" WARD"
  1. S:($L(X)+$L(GMTSV)+3)'>30&($L(GMTSV))&(X'[GMTSV) X=X_" ("_GMTSV_")"
  1. S X=$$UP^XLFSTR(X)
  1. Q X
  1. ACT ; Activity
  1. N GMTSL,GMTSFL,GMTSFLA,GMTSFLD,GMTSLA,GMTSLD,GMTSLR,GMTSAM,GMTSLM,GMTSC,GMTSDI,Y,DR,GMTSIENL,GMTSIENS,GMTSMSG K ^TMP("DILIST",$J)
  1. S GMTSIENS=+GMTSIEN_",",GMTSIENL=","_GMTSIENS,DR="1I;2I;9;10"
  1. D LIST^DIC(123.02,GMTSIENL,DR,,"*",,,,,,.GMTSDI,"GMTSMSG")
  1. K:+($G(^TMP("DILIST",$J,0)))=0 ^TMP("DILIST",$J) Q:+($G(^TMP("DILIST",$J,0)))=0
  1. S GMTSLA="",GMTSLD=0,GMTSLR="",GMTSAM="",GMTSC=0
  1. S GMTSL=0
  1. F S GMTSL=$O(^TMP("DILIST",$J,"ID",GMTSL)) Q:+GMTSL=0 D
  1. . I +($G(^TMP("DILIST",$J,"ID",GMTSL,2)))'<GMTSLD,+($G(^TMP("DILIST",$J,"ID",GMTSL,2)))>0 D
  1. . . S GMTSLA=+($G(^TMP("DILIST",$J,"ID",GMTSL,1)))
  1. . . S GMTSLD=+($G(^TMP("DILIST",$J,"ID",GMTSL,2)))
  1. . . S GMTSLR=$G(^TMP("DILIST",$J,"ID",GMTSL,9))
  1. . . S GMTSLM=$G(^TMP("DILIST",$J,"ID",GMTSL,10))
  1. I +($G(GMTSFLA))>0,+($G(GMTSFLD))>0,+($G(GMTSFL))>0,+($G(GMTSR))'>0 S GMTSC=0,GMTSLA=GMTSFLA,GMTSLD=GMTSFLA D AAC
  1. I GMTSLA>0,GMTSLD>0 S GMTSC=1 D AAC
  1. K ^TMP("DILIST",$J)
  1. Q
  1. AAC ; Add Activity
  1. N GMTSEA,GMTSEP,GMTSEL,GMTSOR,GMTSW,I S GMTSC=+($G(GMTSC))
  1. S GMTSOR=$$UP^XLFSTR($$GET1^DIQ(123.1,GMTSLA,1,"I"))
  1. S GMTSEP=$$UP^XLFSTR($$GET1^DIQ(123.1,GMTSLA,7,"E"))
  1. S GMTSEA=$$UP^XLFSTR($$GET1^DIQ(123.1,GMTSLA,.01,"E"))
  1. S GMTSEL=$$AL(GMTSEA,GMTSEP) Q:'$L(GMTSEL)
  1. S GMTSEA=$$AN(GMTSEA,GMTSEP) Q:'$L(GMTSEA)
  1. I GMTSC>0 D
  1. . 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
  1. . 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)
  1. I GMTSC'>0 D
  1. . 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
  1. . S ^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,"LD","I")=GMTSLD,^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,"LD","E")=$$EDT^GMTSU(GMTSLD)
  1. . S ^TMP("GMTSCN",$J,GMTSI,123,GMTSIENS,40,"WR","E")=$G(^TMP("DILIST",$J,"ID",GMTSFL,3))
  1. Q
  1. AN(X,Y) ; Activity Name
  1. N GMTSW,GMTSP,GMTSA S GMTSA=$G(X),GMTSP=$G(Y) S X=$$SN((GMTSA_" "_GMTSP)) S X=$E(X,1,11) Q X
  1. AL(X,Y) ; Activity Name
  1. N GMTSP,GMTSA S GMTSA=$G(X),GMTSP=$G(Y) S:GMTSA["RECEIVE" (GMTSA,GMTSP)="RECEIVED"
  1. S:GMTSA="ENTERED IN CPRS"!(GMTSA["CPRS RELEASED") (GMTSA,GMTSP)="DATA ENTRY" S:GMTSA="EDIT BEFORE RELEASE" (GMTSA,GMTSP)="EDITED"
  1. 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:"")
  1. Q X
  1. SN(X) ;
  1. S X=$G(X) Q:X="" "UNKNOWN" Q:X["ENTERED"!(X["RELEASED") "ENTERED" Q:X["STATUS" "STAT CHG"
  1. Q:X["SIGNIF" "SIG FIND" Q:X["DISCONT" "DISCONT'D" Q:X["SCHEDUL" "SCHEDULED" Q:X["INCOMPL" "INCOMPLETE" Q:X["COMPLET" "COMPLETE"
  1. Q:X["EDIT" "EDITED" Q:X["DISASSO" "DISASSOC'D" Q:X["ADDENDUM" "ADDENDUM" Q:X["NEW NOTE" "NEW NOTE"
  1. 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"
  1. Q "UNKNOWN"