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

GMRCSLM4.m

Go to the documentation of this file.
  1. GMRCSLM4 ;SLC/DCM - List Manager routine - Activity Log Detailed Display ;08/05/14 13:06
  1. ;;3.0;CONSULT/REQUEST TRACKING;**4,12,15,22,50,64,72,73**;DEC 27,1997;Build 22
  1. ;
  1. ACTLOG(GMRCO) ;Print activity log
  1. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
  1. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Facility",GMRCCT=GMRCCT+1
  1. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=" Activity"_$E(TAB,1,16)_"Date/Time/Zone"_$E(TAB,1,6)_"Responsible Person"_$E(TAB,1,2)_"Entered By",GMRCCT=GMRCCT+1
  1. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=$$REPEAT^XLFSTR("-",79),GMRCCT=GMRCCT+1
  1. N GMRCD,GMRCDA
  1. S GMRCD=0 F S GMRCD=$O(^GMR(123,+GMRCO,40,"B",GMRCD)) Q:'GMRCD S GMRCDA="" F S GMRCDA=$O(^GMR(123,+GMRCO,40,"B",GMRCD,GMRCDA)) Q:'GMRCDA D BLDALN(GMRCO,GMRCDA)
  1. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
  1. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Note: TIME ZONE is local if not indicated",GMRCCT=GMRCCT+1
  1. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
  1. Q
  1. ;
  1. BLDALN(GMRCO,GMRCDA) ;Build Activity Log Lines for an activity
  1. ; GMRCO= consult internal entry number
  1. ; GMRCDA= activity internal entry number
  1. N GMRCACT,GMRCSLN,XDT1,XDT2,FLG,LN,LINE,DASH,X,GMRCX,GMRCDEV,GMRCISIT,GMRC3LN
  1. S GMRCDA(0)=^GMR(123,+GMRCO,40,GMRCDA,0)
  1. S GMRCACT=$P(GMRCDA(0),"^",2)
  1. S GMRCDA(2)=$G(^GMR(123,+GMRCO,40,GMRCDA,2))
  1. S GMRCDA(3)=$G(^GMR(123,+GMRCO,40,GMRCDA,3))
  1. I $D(^GMR(123,GMRCO,40,GMRCDA,2)) D
  1. . S GMRCISIT=$P(^GMR(123,GMRCO,0),U,23) Q:'GMRCISIT
  1. . S GMRCISIT=$$GET1^DIQ(4,GMRCISIT,.01)
  1. D BLDLN1
  1. D BLDLN2
  1. D BLDCMTS
  1. Q
  1. ;
  1. BLDLN1 ;Build the first line for the activity
  1. ;GMRCX is scratch pad variable
  1. I $L($G(GMRCISIT)) D
  1. . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=GMRCISIT
  1. . S GMRCCT=GMRCCT+1
  1. S GMRCX=$P($G(^GMR(123.1,+GMRCACT,0)),"^",1)
  1. S:'$L(GMRCX) GMRCX=GMRCACT_" action?"
  1. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=" "_GMRCX
  1. ;
  1. ;Add to line for Printed to (action 22) when device name <13 characters
  1. I GMRCACT=22 D
  1. . S GMRCDEV=$$GET1^DIQ(3.5,+$P(GMRCDA(0),"^",8),.01)
  1. . I '$L(GMRCDEV) S GMRCDEV=$P(GMRCDA(0),"^",8)
  1. . I $L(GMRCDEV)<13 S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=^TMP("GMRCR",$J,"DT",GMRCCT,0)_" "_GMRCDEV K GMRCDEV
  1. ;
  1. ;Add on generic fields that apply to every activity
  1. ;Date/time of Actual Activity, Who's Responsible for Activity,
  1. ;and Who entered activity
  1. S X=$P(GMRCDA(0),"^",3) D REGDTM^GMRCU S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=$S($D(^TMP("GMRCR",$J,"DT",GMRCCT,0)):^TMP("GMRCR",$J,"DT",GMRCCT,0)_$E(TAB,1,25-$L(^(0)))_X,1:X)_$E(TAB)_$S($P(GMRCDA(2),"^",3)]"":$P(GMRCDA(2),"^",3),1:$E(TAB,1,3))
  1. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=^TMP("GMRCR",$J,"DT",GMRCCT,0)_$E(TAB,1,45-$L(^(0)))_$S($P(GMRCDA(2),"^",2)]"":$E($P(GMRCDA(2),"^",2),1,17),$P(GMRCDA(0),"^",4):$E($P($G(^VA(200,$P(GMRCDA(0),"^",4),0)),"^"),1,17),1:$E(TAB,1,18))
  1. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=^TMP("GMRCR",$J,"DT",GMRCCT,0)_$E(TAB,1,65-$L(^(0)))_$S($P(GMRCDA(2),"^")]"":$E($P(GMRCDA(2),"^"),1,17),$P(GMRCDA(0),"^",5):$E($P($G(^VA(200,$P(GMRCDA(0),"^",5),0)),"^"),1,17),1:$E(TAB,1,17))
  1. S GMRCCT=GMRCCT+1
  1. Q
  1. ;
  1. BLDLN2 ;SECOND line for activity
  1. N GMRCSLN S GMRCSLN="" ;saved SECOND line
  1. ;
  1. ; Check if the entry date and specified actual date are different
  1. S XDT1=$P(GMRCDA(0),"^",1),XDT2=$P(GMRCDA(0),"^",3),GMRCX=0
  1. S:XDT2>XDT1 X=XDT1,XDT1=XDT2,XDT2=X
  1. S GMRCDIF=$$FMDIFF^XLFDT(XDT1,XDT2,3)
  1. I $L(GMRCDIF) D
  1. . I +$P(GMRCDIF," ",1)>0 S GMRCX=1 Q ;Check Days
  1. . S GMRCDIF=$P(GMRCDIF," ",2)
  1. . I +$P(GMRCDIF,":",1)>0 S GMRCX=1 Q ;Check Hours
  1. . I +$P(GMRCDIF,":",2)>1 S GMRCX=1 Q ;Check Minutes
  1. . Q
  1. I GMRCX D
  1. . S X=$P(GMRCDA(0),"^",1) D REGDTM^GMRCU
  1. . ;S GMRCSLN=$E(GMRCSLN_TAB,1,15)_"(entered) "_X_$E(TAB)_$S($P(GMRCDA(2),"^",3)]"":$P(GMRCDA(2),"^",3),1:$E(TAB,1,3))
  1. . S GMRCSLN=$E(GMRCSLN_TAB,1,15)_"(entered) "_X_$E(TAB,1,4)
  1. . Q
  1. ;
  1. I $L($G(GMRCSLN)) D S GMRCSLN=""
  1. . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=GMRCSLN
  1. . S GMRCCT=GMRCCT+1
  1. . Q
  1. ;
  1. ;Get local Incomplete Report and Complete result # for second line of action
  1. I +$P(GMRCDA(0),"^",9) D
  1. . I $P($P(GMRCDA(0),"^",9),";",2)["TIU" D Q
  1. .. S GMRCSLN=$E(TAB,1,5)_"Note# "_+$P(GMRCDA(0),"^",9)
  1. . I $P($P(GMRCDA(0),"^",9),";",2)["MCAR" D Q
  1. .. N MCFILE S MCFILE=+$P($P(GMRCDA(0),"^",9),"MCAR(",2) Q:'MCFILE
  1. .. N MCPRDT S MCPRDT=$$GET1^DIQ(MCFILE,+$P(GMRCDA(0),"^",9),.01)
  1. .. Q:'$L(MCPRDT)
  1. .. S GMRCSLN=$E(TAB,1,5)_"Medicine Procedure performed: "_MCPRDT
  1. ;
  1. ;Get remote Incomplete Report and Complete result # for second line of action
  1. I +$P(GMRCDA(2),"^",4) D
  1. . N GMRCRR S GMRCRR=$P(GMRCDA(2),"^",4)
  1. . S GMRCSLN=$E(TAB,1,5)_"Remote "_$P(GMRCRR,";",3)_" #"_+$P(GMRCRR,";")_" from "_$P($G(^DIC(4,+$P(GMRCRR,";",4),0)),"^")
  1. ;
  1. ;If GMRCDEV is defined, then print the device name on the second line
  1. I GMRCACT=22,$D(GMRCDEV) D
  1. . S GMRCSLN=$E(TAB,1,5)_$E(GMRCDEV,1,17) K GMRCDEV
  1. ;
  1. ;Build line for forwarded to (action 17)
  1. I GMRCACT=17 D
  1. . S GMRCX=$S(+$P(GMRCDA(0),"^",6):$P($G(^GMR(123.5,+$P(GMRCDA(0),"^",6),0)),"^"),$P(GMRCDA(3),"^")]"":$P(GMRCDA(3),"^"),1:" ??")
  1. . S GMRCSLN=$E(TAB,1,5)_GMRCX
  1. . I $P(GMRCDA(0),"^",7)'="" S GMRC3LN="Previous Attention: "_$P($G(^VA(200,$P(GMRCDA(0),"^",7),0)),"^")
  1. I GMRCACT=25 D
  1. . S GMRCX=""
  1. . I $P(^GMR(123,+GMRCO,12),U,5)="F" D
  1. .. S GMRCX="Previous remote service name: "
  1. . S GMRCX=GMRCX_$S(+$P(GMRCDA(0),"^",6):$P($G(^GMR(123.5,+$P(GMRCDA(0),"^",6),0)),"^"),$P(GMRCDA(3),"^")]"":$P(GMRCDA(3),"^"),1:" ??")
  1. . S GMRCSLN=$E(TAB,1,5)_GMRCX
  1. . I $P(GMRCDA(0),"^",7)'="" S GMRC3LN="Previous Attention: "_$P($G(^VA(200,$P(GMRCDA(0),"^",7),0)),"^")
  1. ;
  1. I $L($G(GMRCSLN)) D S GMRCSLN=""
  1. . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=GMRCSLN
  1. . S GMRCCT=GMRCCT+1
  1. . Q
  1. I $D(GMRC3LN) D
  1. . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=GMRC3LN
  1. . S GMRCCT=GMRCCT+1
  1. . Q
  1. ;
  1. Q
  1. ;
  1. BLDCMTS ;Build lines for Comment activity.
  1. I GMRCACT=11 D BLDCMT Q
  1. ;
  1. ;Build lines for general comments on any activity
  1. I $D(^GMR(123,+GMRCO,40,+GMRCDA,1)) D Q
  1. . S LN=$O(^GMR(123,+GMRCO,40,+GMRCDA,1,0)) Q:'+LN
  1. . ;Check for edited fields generated text with lines <75 characters
  1. . I $G(^GMR(123,+GMRCO,40,+GMRCDA,1,LN,0))["EDITED FIELDS" D BLDCMT Q
  1. . D BLDCMT
  1. . Q
  1. . I $L($G(^GMR(123,+GMRCO,40,+GMRCDA,1,LN,0)))'>75 D BLDCMT Q
  1. . ;Use utilities for long line formating
  1. . S FLG=1,LINE=" "
  1. . D WPSET^GMRCUTIL("^GMR(123,+GMRCO,40,GMRCDA,1)","^TMP(""GMRCR"",$J,""DT"")",LINE,.GMRCCT,TAB,FLG)
  1. . D BLDASH
  1. . Q
  1. Q
  1. ;
  1. BLDCMT ;Build comment lines
  1. ;DASH is 1 or "" for print dash line after comment
  1. S LN=0
  1. N GMRCLINE,SEG,BUFFER,PIECE
  1. F S LN=$O(^GMR(123,+GMRCO,40,+GMRCDA,1,LN)) Q:'+LN D
  1. . S GMRCLINE=^GMR(123,+GMRCO,40,GMRCDA,1,LN,0)
  1. . I $E(GMRCLINE,1,22)="Provisional Diagnosis:"&($L($G(GMRCLINE))>80) D
  1. .. F S PIECE=$L(GMRCLINE) Q:PIECE<80 D ;$L of GMRCLINE will change below, so hold original length in PIECE
  1. ... N SEG,I S I=2
  1. ... F S SEG=$P(GMRCLINE," ",1,I) Q:$L(SEG)>=80!($L(SEG," ")<I) S I=I+1
  1. ... I $L(SEG)=$L(GMRCLINE) S SEG=$E(GMRCLINE,1,80) ;means GMRCLINE doesn't contain spaces, e.g. v55,250.00,414.00,etc.
  1. ... S BUFFER=SEG
  1. ... S:SEG[" " SEG=$P(GMRCLINE," ",1,(I-1)) I $L(SEG)=0 S SEG=$E(BUFFER,1,80) ;$P only good when SEG contains a space, otherwise grab a SEG from BUFFER
  1. ... S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=SEG,GMRCCT=GMRCCT+1
  1. ... S GMRCLINE=$E(GMRCLINE,$L(SEG)+1,999)
  1. . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=GMRCLINE ;$P(^GMR(123,+GMRCO,40,GMRCDA,1,LN,0),"^",1)
  1. . S GMRCCT=GMRCCT+1
  1. . Q
  1. ;D BLDASH
  1. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
  1. Q
  1. ;
  1. BLDASH ;Build separater line with dashes
  1. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",$P(^(0),"-",80)="",GMRCCT=GMRCCT+1
  1. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
  1. Q