- 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 Dec 13, 2024@01:47:12 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