GMRCSLM4 ;SLC/DCM - List Manager routine - Activity Log Detailed Display ;08/05/14 13:06
;;3.0;CONSULT/REQUEST TRACKING;**4,12,15,22,50,64,72,73**;DEC 27,1997;Build 22
;
ACTLOG(GMRCO) ;Print activity log
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Facility",GMRCCT=GMRCCT+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
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=$$REPEAT^XLFSTR("-",79),GMRCCT=GMRCCT+1
N GMRCD,GMRCDA
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)
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Note: TIME ZONE is local if not indicated",GMRCCT=GMRCCT+1
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
Q
;
BLDALN(GMRCO,GMRCDA) ;Build Activity Log Lines for an activity
; GMRCO= consult internal entry number
; GMRCDA= activity internal entry number
N GMRCACT,GMRCSLN,XDT1,XDT2,FLG,LN,LINE,DASH,X,GMRCX,GMRCDEV,GMRCISIT,GMRC3LN
S GMRCDA(0)=^GMR(123,+GMRCO,40,GMRCDA,0)
S GMRCACT=$P(GMRCDA(0),"^",2)
S GMRCDA(2)=$G(^GMR(123,+GMRCO,40,GMRCDA,2))
S GMRCDA(3)=$G(^GMR(123,+GMRCO,40,GMRCDA,3))
I $D(^GMR(123,GMRCO,40,GMRCDA,2)) D
. S GMRCISIT=$P(^GMR(123,GMRCO,0),U,23) Q:'GMRCISIT
. S GMRCISIT=$$GET1^DIQ(4,GMRCISIT,.01)
D BLDLN1
D BLDLN2
D BLDCMTS
Q
;
BLDLN1 ;Build the first line for the activity
;GMRCX is scratch pad variable
I $L($G(GMRCISIT)) D
. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=GMRCISIT
. S GMRCCT=GMRCCT+1
S GMRCX=$P($G(^GMR(123.1,+GMRCACT,0)),"^",1)
S:'$L(GMRCX) GMRCX=GMRCACT_" action?"
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=" "_GMRCX
;
;Add to line for Printed to (action 22) when device name <13 characters
I GMRCACT=22 D
. S GMRCDEV=$$GET1^DIQ(3.5,+$P(GMRCDA(0),"^",8),.01)
. I '$L(GMRCDEV) S GMRCDEV=$P(GMRCDA(0),"^",8)
. I $L(GMRCDEV)<13 S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=^TMP("GMRCR",$J,"DT",GMRCCT,0)_" "_GMRCDEV K GMRCDEV
;
;Add on generic fields that apply to every activity
;Date/time of Actual Activity, Who's Responsible for Activity,
;and Who entered activity
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))
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))
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))
S GMRCCT=GMRCCT+1
Q
;
BLDLN2 ;SECOND line for activity
N GMRCSLN S GMRCSLN="" ;saved SECOND line
;
; Check if the entry date and specified actual date are different
S XDT1=$P(GMRCDA(0),"^",1),XDT2=$P(GMRCDA(0),"^",3),GMRCX=0
S:XDT2>XDT1 X=XDT1,XDT1=XDT2,XDT2=X
S GMRCDIF=$$FMDIFF^XLFDT(XDT1,XDT2,3)
I $L(GMRCDIF) D
. I +$P(GMRCDIF," ",1)>0 S GMRCX=1 Q ;Check Days
. S GMRCDIF=$P(GMRCDIF," ",2)
. I +$P(GMRCDIF,":",1)>0 S GMRCX=1 Q ;Check Hours
. I +$P(GMRCDIF,":",2)>1 S GMRCX=1 Q ;Check Minutes
. Q
I GMRCX D
. S X=$P(GMRCDA(0),"^",1) D REGDTM^GMRCU
. ;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))
. S GMRCSLN=$E(GMRCSLN_TAB,1,15)_"(entered) "_X_$E(TAB,1,4)
. Q
;
I $L($G(GMRCSLN)) D S GMRCSLN=""
. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=GMRCSLN
. S GMRCCT=GMRCCT+1
. Q
;
;Get local Incomplete Report and Complete result # for second line of action
I +$P(GMRCDA(0),"^",9) D
. I $P($P(GMRCDA(0),"^",9),";",2)["TIU" D Q
.. S GMRCSLN=$E(TAB,1,5)_"Note# "_+$P(GMRCDA(0),"^",9)
. I $P($P(GMRCDA(0),"^",9),";",2)["MCAR" D Q
.. N MCFILE S MCFILE=+$P($P(GMRCDA(0),"^",9),"MCAR(",2) Q:'MCFILE
.. N MCPRDT S MCPRDT=$$GET1^DIQ(MCFILE,+$P(GMRCDA(0),"^",9),.01)
.. Q:'$L(MCPRDT)
.. S GMRCSLN=$E(TAB,1,5)_"Medicine Procedure performed: "_MCPRDT
;
;Get remote Incomplete Report and Complete result # for second line of action
I +$P(GMRCDA(2),"^",4) D
. N GMRCRR S GMRCRR=$P(GMRCDA(2),"^",4)
. S GMRCSLN=$E(TAB,1,5)_"Remote "_$P(GMRCRR,";",3)_" #"_+$P(GMRCRR,";")_" from "_$P($G(^DIC(4,+$P(GMRCRR,";",4),0)),"^")
;
;If GMRCDEV is defined, then print the device name on the second line
I GMRCACT=22,$D(GMRCDEV) D
. S GMRCSLN=$E(TAB,1,5)_$E(GMRCDEV,1,17) K GMRCDEV
;
;Build line for forwarded to (action 17)
I GMRCACT=17 D
. S GMRCX=$S(+$P(GMRCDA(0),"^",6):$P($G(^GMR(123.5,+$P(GMRCDA(0),"^",6),0)),"^"),$P(GMRCDA(3),"^")]"":$P(GMRCDA(3),"^"),1:" ??")
. S GMRCSLN=$E(TAB,1,5)_GMRCX
. I $P(GMRCDA(0),"^",7)'="" S GMRC3LN="Previous Attention: "_$P($G(^VA(200,$P(GMRCDA(0),"^",7),0)),"^")
I GMRCACT=25 D
. S GMRCX=""
. I $P(^GMR(123,+GMRCO,12),U,5)="F" D
.. S GMRCX="Previous remote service name: "
. 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:" ??")
. S GMRCSLN=$E(TAB,1,5)_GMRCX
. I $P(GMRCDA(0),"^",7)'="" S GMRC3LN="Previous Attention: "_$P($G(^VA(200,$P(GMRCDA(0),"^",7),0)),"^")
;
I $L($G(GMRCSLN)) D S GMRCSLN=""
. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=GMRCSLN
. S GMRCCT=GMRCCT+1
. Q
I $D(GMRC3LN) D
. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=GMRC3LN
. S GMRCCT=GMRCCT+1
. Q
;
Q
;
BLDCMTS ;Build lines for Comment activity.
I GMRCACT=11 D BLDCMT Q
;
;Build lines for general comments on any activity
I $D(^GMR(123,+GMRCO,40,+GMRCDA,1)) D Q
. S LN=$O(^GMR(123,+GMRCO,40,+GMRCDA,1,0)) Q:'+LN
. ;Check for edited fields generated text with lines <75 characters
. I $G(^GMR(123,+GMRCO,40,+GMRCDA,1,LN,0))["EDITED FIELDS" D BLDCMT Q
. D BLDCMT
. Q
. I $L($G(^GMR(123,+GMRCO,40,+GMRCDA,1,LN,0)))'>75 D BLDCMT Q
. ;Use utilities for long line formating
. S FLG=1,LINE=" "
. D WPSET^GMRCUTIL("^GMR(123,+GMRCO,40,GMRCDA,1)","^TMP(""GMRCR"",$J,""DT"")",LINE,.GMRCCT,TAB,FLG)
. D BLDASH
. Q
Q
;
BLDCMT ;Build comment lines
;DASH is 1 or "" for print dash line after comment
S LN=0
N GMRCLINE,SEG,BUFFER,PIECE
F S LN=$O(^GMR(123,+GMRCO,40,+GMRCDA,1,LN)) Q:'+LN D
. S GMRCLINE=^GMR(123,+GMRCO,40,GMRCDA,1,LN,0)
. I $E(GMRCLINE,1,22)="Provisional Diagnosis:"&($L($G(GMRCLINE))>80) D
.. F S PIECE=$L(GMRCLINE) Q:PIECE<80 D ;$L of GMRCLINE will change below, so hold original length in PIECE
... N SEG,I S I=2
... F S SEG=$P(GMRCLINE," ",1,I) Q:$L(SEG)>=80!($L(SEG," ")<I) S I=I+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.
... S BUFFER=SEG
... 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
... S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=SEG,GMRCCT=GMRCCT+1
... S GMRCLINE=$E(GMRCLINE,$L(SEG)+1,999)
. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=GMRCLINE ;$P(^GMR(123,+GMRCO,40,GMRCDA,1,LN,0),"^",1)
. S GMRCCT=GMRCCT+1
. Q
;D BLDASH
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
Q
;
BLDASH ;Build separater line with dashes
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",$P(^(0),"-",80)="",GMRCCT=GMRCCT+1
S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCSLM4 7643 printed Apr 09, 2024@20:52:27 Page 2
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
+2 ;
ACTLOG(GMRCO) ;Print activity log
+1 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+2 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Facility"
SET GMRCCT=GMRCCT+1
+3 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=" Activity"_$EXTRACT(TAB,1,16)_"Date/Time/Zone"_$EXTRACT(TAB,1,6)_"Responsible Person"_$EXTRACT(TAB,1,2)_"Entered By"
SET GMRCCT=GMRCCT+1
+4 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=$$REPEAT^XLFSTR("-",79)
SET GMRCCT=GMRCCT+1
+5 NEW GMRCD,GMRCDA
+6 SET GMRCD=0
FOR
SET GMRCD=$ORDER(^GMR(123,+GMRCO,40,"B",GMRCD))
if 'GMRCD
QUIT
SET GMRCDA=""
FOR
SET GMRCDA=$ORDER(^GMR(123,+GMRCO,40,"B",GMRCD,GMRCDA))
if 'GMRCDA
QUIT
DO BLDALN(GMRCO,GMRCDA)
+7 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+8 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)="Note: TIME ZONE is local if not indicated"
SET GMRCCT=GMRCCT+1
+9 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+10 QUIT
+11 ;
BLDALN(GMRCO,GMRCDA) ;Build Activity Log Lines for an activity
+1 ; GMRCO= consult internal entry number
+2 ; GMRCDA= activity internal entry number
+3 NEW GMRCACT,GMRCSLN,XDT1,XDT2,FLG,LN,LINE,DASH,X,GMRCX,GMRCDEV,GMRCISIT,GMRC3LN
+4 SET GMRCDA(0)=^GMR(123,+GMRCO,40,GMRCDA,0)
+5 SET GMRCACT=$PIECE(GMRCDA(0),"^",2)
+6 SET GMRCDA(2)=$GET(^GMR(123,+GMRCO,40,GMRCDA,2))
+7 SET GMRCDA(3)=$GET(^GMR(123,+GMRCO,40,GMRCDA,3))
+8 IF $DATA(^GMR(123,GMRCO,40,GMRCDA,2))
Begin DoDot:1
+9 SET GMRCISIT=$PIECE(^GMR(123,GMRCO,0),U,23)
if 'GMRCISIT
QUIT
+10 SET GMRCISIT=$$GET1^DIQ(4,GMRCISIT,.01)
End DoDot:1
+11 DO BLDLN1
+12 DO BLDLN2
+13 DO BLDCMTS
+14 QUIT
+15 ;
BLDLN1 ;Build the first line for the activity
+1 ;GMRCX is scratch pad variable
+2 IF $LENGTH($GET(GMRCISIT))
Begin DoDot:1
+3 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=GMRCISIT
+4 SET GMRCCT=GMRCCT+1
End DoDot:1
+5 SET GMRCX=$PIECE($GET(^GMR(123.1,+GMRCACT,0)),"^",1)
+6 if '$LENGTH(GMRCX)
SET GMRCX=GMRCACT_" action?"
+7 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=" "_GMRCX
+8 ;
+9 ;Add to line for Printed to (action 22) when device name <13 characters
+10 IF GMRCACT=22
Begin DoDot:1
+11 SET GMRCDEV=$$GET1^DIQ(3.5,+$PIECE(GMRCDA(0),"^",8),.01)
+12 IF '$LENGTH(GMRCDEV)
SET GMRCDEV=$PIECE(GMRCDA(0),"^",8)
+13 IF $LENGTH(GMRCDEV)<13
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=^TMP("GMRCR",$JOB,"DT",GMRCCT,0)_" "_GMRCDEV
KILL GMRCDEV
End DoDot:1
+14 ;
+15 ;Add on generic fields that apply to every activity
+16 ;Date/time of Actual Activity, Who's Responsible for Activity,
+17 ;and Who entered activity
+18 SET X=$PIECE(GMRCDA(0),"^",3)
DO REGDTM^GMRCU
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=$SELECT($DATA(^TMP("GMRCR",$JOB,"DT",GMRCCT,0)):^TMP("GMRCR",$JOB,"DT",GMRCCT,0)_$EXTRACT(TAB,1,25-$LENGTH(^(0)))_X,1:X)_$EXTRACT(TAB)_$SELECT($PIECE(GMRCDA(2),"^",3)]"":$PIECE(GMRCDA(2),"^",3),1:$EXTRACT(TA
B,1,3))
+19 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=^TMP("GMRCR",$JOB,"DT",GMRCCT,0)_$EXTRACT(TAB,1,45-$LENGTH(^(0)))_$SELECT(...
... $PIECE(GMRCDA(2),"^",2)]"":$EXTRACT($PIECE(GMRCDA(2),"^",2),1,17),$PIECE(GMRCDA(0),"^",4):$EXTRACT($PIECE($GET(^VA(200,$PIECE(GMRCDA(0),"^",4),0)),"^"),1,17),1:$EXTRACT(TAB,1,18))
+20 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=^TMP("GMRCR",$JOB,"DT",GMRCCT,0)_$EXTRACT(TAB,1,65-$LENGTH(^(0)))_$SELECT($PIECE(GMRCDA(2),"^")]"":...
... $EXTRACT($PIECE(GMRCDA(2),"^"),1,17),$PIECE(GMRCDA(0),"^",5):$EXTRACT($PIECE($GET(^VA(200,$PIECE(GMRCDA(0),"^",5),0)),"^"),1,17),1:$EXTRACT(TAB,1,17))
+21 SET GMRCCT=GMRCCT+1
+22 QUIT
+23 ;
BLDLN2 ;SECOND line for activity
+1 ;saved SECOND line
NEW GMRCSLN
SET GMRCSLN=""
+2 ;
+3 ; Check if the entry date and specified actual date are different
+4 SET XDT1=$PIECE(GMRCDA(0),"^",1)
SET XDT2=$PIECE(GMRCDA(0),"^",3)
SET GMRCX=0
+5 if XDT2>XDT1
SET X=XDT1
SET XDT1=XDT2
SET XDT2=X
+6 SET GMRCDIF=$$FMDIFF^XLFDT(XDT1,XDT2,3)
+7 IF $LENGTH(GMRCDIF)
Begin DoDot:1
+8 ;Check Days
IF +$PIECE(GMRCDIF," ",1)>0
SET GMRCX=1
QUIT
+9 SET GMRCDIF=$PIECE(GMRCDIF," ",2)
+10 ;Check Hours
IF +$PIECE(GMRCDIF,":",1)>0
SET GMRCX=1
QUIT
+11 ;Check Minutes
IF +$PIECE(GMRCDIF,":",2)>1
SET GMRCX=1
QUIT
+12 QUIT
End DoDot:1
+13 IF GMRCX
Begin DoDot:1
+14 SET X=$PIECE(GMRCDA(0),"^",1)
DO REGDTM^GMRCU
+15 ;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))
+16 SET GMRCSLN=$EXTRACT(GMRCSLN_TAB,1,15)_"(entered) "_X_$EXTRACT(TAB,1,4)
+17 QUIT
End DoDot:1
+18 ;
+19 IF $LENGTH($GET(GMRCSLN))
Begin DoDot:1
+20 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=GMRCSLN
+21 SET GMRCCT=GMRCCT+1
+22 QUIT
End DoDot:1
SET GMRCSLN=""
+23 ;
+24 ;Get local Incomplete Report and Complete result # for second line of action
+25 IF +$PIECE(GMRCDA(0),"^",9)
Begin DoDot:1
+26 IF $PIECE($PIECE(GMRCDA(0),"^",9),";",2)["TIU"
Begin DoDot:2
+27 SET GMRCSLN=$EXTRACT(TAB,1,5)_"Note# "_+$PIECE(GMRCDA(0),"^",9)
End DoDot:2
QUIT
+28 IF $PIECE($PIECE(GMRCDA(0),"^",9),";",2)["MCAR"
Begin DoDot:2
+29 NEW MCFILE
SET MCFILE=+$PIECE($PIECE(GMRCDA(0),"^",9),"MCAR(",2)
if 'MCFILE
QUIT
+30 NEW MCPRDT
SET MCPRDT=$$GET1^DIQ(MCFILE,+$PIECE(GMRCDA(0),"^",9),.01)
+31 if '$LENGTH(MCPRDT)
QUIT
+32 SET GMRCSLN=$EXTRACT(TAB,1,5)_"Medicine Procedure performed: "_MCPRDT
End DoDot:2
QUIT
End DoDot:1
+33 ;
+34 ;Get remote Incomplete Report and Complete result # for second line of action
+35 IF +$PIECE(GMRCDA(2),"^",4)
Begin DoDot:1
+36 NEW GMRCRR
SET GMRCRR=$PIECE(GMRCDA(2),"^",4)
+37 SET GMRCSLN=$EXTRACT(TAB,1,5)_"Remote "_$PIECE(GMRCRR,";",3)_" #"_+$PIECE(GMRCRR,";")_" from "_$PIECE($GET(^DIC(4,+$PIECE(GMRCRR,";",4),0)),"^")
End DoDot:1
+38 ;
+39 ;If GMRCDEV is defined, then print the device name on the second line
+40 IF GMRCACT=22
IF $DATA(GMRCDEV)
Begin DoDot:1
+41 SET GMRCSLN=$EXTRACT(TAB,1,5)_$EXTRACT(GMRCDEV,1,17)
KILL GMRCDEV
End DoDot:1
+42 ;
+43 ;Build line for forwarded to (action 17)
+44 IF GMRCACT=17
Begin DoDot:1
+45 SET GMRCX=$SELECT(+$PIECE(GMRCDA(0),"^",6):$PIECE($GET(^GMR(123.5,+$PIECE(GMRCDA(0),"^",6),0)),"^"),$PIECE(GMRCDA(3),"^")]"":$PIECE(GMRCDA(3),"^"),1:" ??")
+46 SET GMRCSLN=$EXTRACT(TAB,1,5)_GMRCX
+47 IF $PIECE(GMRCDA(0),"^",7)'=""
SET GMRC3LN="Previous Attention: "_$PIECE($GET(^VA(200,$PIECE(GMRCDA(0),"^",7),0)),"^")
End DoDot:1
+48 IF GMRCACT=25
Begin DoDot:1
+49 SET GMRCX=""
+50 IF $PIECE(^GMR(123,+GMRCO,12),U,5)="F"
Begin DoDot:2
+51 SET GMRCX="Previous remote service name: "
End DoDot:2
+52 SET GMRCX=GMRCX_$SELECT(+$PIECE(GMRCDA(0),"^",6):$PIECE($GET(^GMR(123.5,+$PIECE(GMRCDA(0),"^",6),0)),"^"),$PIECE(GMRCDA(3),"^")]"":$PIECE(GMRCDA(3),"^"),1:" ??")
+53 SET GMRCSLN=$EXTRACT(TAB,1,5)_GMRCX
+54 IF $PIECE(GMRCDA(0),"^",7)'=""
SET GMRC3LN="Previous Attention: "_$PIECE($GET(^VA(200,$PIECE(GMRCDA(0),"^",7),0)),"^")
End DoDot:1
+55 ;
+56 IF $LENGTH($GET(GMRCSLN))
Begin DoDot:1
+57 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=GMRCSLN
+58 SET GMRCCT=GMRCCT+1
+59 QUIT
End DoDot:1
SET GMRCSLN=""
+60 IF $DATA(GMRC3LN)
Begin DoDot:1
+61 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=GMRC3LN
+62 SET GMRCCT=GMRCCT+1
+63 QUIT
End DoDot:1
+64 ;
+65 QUIT
+66 ;
BLDCMTS ;Build lines for Comment activity.
+1 IF GMRCACT=11
DO BLDCMT
QUIT
+2 ;
+3 ;Build lines for general comments on any activity
+4 IF $DATA(^GMR(123,+GMRCO,40,+GMRCDA,1))
Begin DoDot:1
+5 SET LN=$ORDER(^GMR(123,+GMRCO,40,+GMRCDA,1,0))
if '+LN
QUIT
+6 ;Check for edited fields generated text with lines <75 characters
+7 IF $GET(^GMR(123,+GMRCO,40,+GMRCDA,1,LN,0))["EDITED FIELDS"
DO BLDCMT
QUIT
+8 DO BLDCMT
+9 QUIT
+10 IF $LENGTH($GET(^GMR(123,+GMRCO,40,+GMRCDA,1,LN,0)))'>75
DO BLDCMT
QUIT
+11 ;Use utilities for long line formating
+12 SET FLG=1
SET LINE=" "
+13 DO WPSET^GMRCUTIL("^GMR(123,+GMRCO,40,GMRCDA,1)","^TMP(""GMRCR"",$J,""DT"")",LINE,.GMRCCT,TAB,FLG)
+14 DO BLDASH
+15 QUIT
End DoDot:1
QUIT
+16 QUIT
+17 ;
BLDCMT ;Build comment lines
+1 ;DASH is 1 or "" for print dash line after comment
+2 SET LN=0
+3 NEW GMRCLINE,SEG,BUFFER,PIECE
+4 FOR
SET LN=$ORDER(^GMR(123,+GMRCO,40,+GMRCDA,1,LN))
if '+LN
QUIT
Begin DoDot:1
+5 SET GMRCLINE=^GMR(123,+GMRCO,40,GMRCDA,1,LN,0)
+6 IF $EXTRACT(GMRCLINE,1,22)="Provisional Diagnosis:"&($LENGTH($GET(GMRCLINE))>80)
Begin DoDot:2
+7 ;$L of GMRCLINE will change below, so hold original length in PIECE
FOR
SET PIECE=$LENGTH(GMRCLINE)
if PIECE<80
QUIT
Begin DoDot:3
+8 NEW SEG,I
SET I=2
+9 FOR
SET SEG=$PIECE(GMRCLINE," ",1,I)
if $LENGTH(SEG)>=80!($LENGTH(SEG," ")<I)
QUIT
SET I=I+1
+10 ;means GMRCLINE doesn't contain spaces, e.g. v55,250.00,414.00,etc.
IF $LENGTH(SEG)=$LENGTH(GMRCLINE)
SET SEG=$EXTRACT(GMRCLINE,1,80)
+11 SET BUFFER=SEG
+12 ;$P only good when SEG contains a space, otherwise grab a SEG from BUFFER
if SEG[" "
SET SEG=$PIECE(GMRCLINE," ",1,(I-1))
IF $LENGTH(SEG)=0
SET SEG=$EXTRACT(BUFFER,1,80)
+13 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=SEG
SET GMRCCT=GMRCCT+1
+14 SET GMRCLINE=$EXTRACT(GMRCLINE,$LENGTH(SEG)+1,999)
End DoDot:3
End DoDot:2
+15 ;$P(^GMR(123,+GMRCO,40,GMRCDA,1,LN,0),"^",1)
SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=GMRCLINE
+16 SET GMRCCT=GMRCCT+1
+17 QUIT
End DoDot:1
+18 ;D BLDASH
+19 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+20 QUIT
+21 ;
BLDASH ;Build separater line with dashes
+1 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=""
SET $PIECE(^(0),"-",80)=""
SET GMRCCT=GMRCCT+1
+2 SET ^TMP("GMRCR",$JOB,"DT",GMRCCT,0)=""
SET GMRCCT=GMRCCT+1
+3 QUIT
