GMRCEDT3 ;SLC/DCM,JFR - file edit/resubmit ;12/10/14 14:42
;;3.0;CONSULT/REQUEST TRACKING;**1,5,15,22,66,73,81**;DEC 27, 1997;Build 6
;
;IRCS in use: #2053 (DIE), #2056 (GET1^DIQ), #10103 (XLFDT), #10104 (XLFSTR)
;
EN(GMRCDA) ;File tracking Data from array
W:'$D(GMRCGUIF) !,"Filing Tracking Data..."
N GMRCOUNT,GMRC40DA
S GMRCDT=$$NOW^XLFDT
S DIE="^GMR(123,",DA=GMRCDA,DR="8////^S X=5" D ^DIE K DIE,DA,DR
I '$D(^GMR(123,GMRCDA,40,0)) S ^GMR(123,GMRCDA,40,0)="123.02^^"
S DA=$S(+$P(^GMR(123,GMRCDA,40,0),"^",3):$P(^(0),"^",3)+1,1:1)
S GMRC40DA=DA
S $P(^GMR(123,GMRCDA,40,0),"^",3,4)=DA_"^"_DA D
.S ^GMR(123,GMRCDA,40,DA,0)=GMRCDT_"^"_$O(^GMR(123.1,"B","EDIT/RESUBMITTED",0))_"^"_GMRCDT_"^"_DUZ_"^"_DUZ D
.S ^GMR(123,GMRCDA,40,DA,1,0)="^^^^"_GMRCDT_"^" D
..S GMRCOUNT=1,GMRCND=0,^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)=$$REPEAT^XLFSTR("-",21)_" PREVIOUS VALUES OF EDITED FIELDS "_$$REPEAT^XLFSTR("-",21),GMRCOUNT=GMRCOUNT+1
..I '$D(GMRCFLD) S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="No Fields Were Edited Before Resubmission",GMRCOUNT=GMRCOUNT+1 Q
..F S GMRCND=$O(GMRCFLD(GMRCND)) Q:GMRCND="" D S GMRCOUNT=GMRCOUNT+1
...I GMRCND=.1 S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="DISPLAY TEXT OF ITEM ORDERED: "_$P(GMRCFLD(GMRCND),"^",1),GMRCOUNT=GMRCOUNT+1 Q
...I GMRCND=1 D S GMRCOUNT=GMRCOUNT+1 Q
....S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="To Service: "_$S($L($P(GMRCFLD(GMRCND),U)):$P(GMRCFLD(GMRCND),U),1:"No Previous Value")
....Q
...I GMRCND=4 S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Procedure: "_$$GET1^DIQ(123.3,+GMRCFLD(4),.01) Q
...I GMRCND=14 S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Performed as Inpt or Outpt: "_$S($L($P(GMRCFLD(GMRCND),"^")):$P(GMRCFLD(GMRCND),U),1:"No Previous Value") Q
...I $S(GMRCND=5:1,GMRCND=6:1,GMRCND=13:1,1:0) D Q
....N CAPTION S CAPTION=$S(GMRCND=5:"Urgency: ",GMRCND=6:"Place of Consultation: ",1:"Type of Request: ")
....S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)=CAPTION_$S($L($P(GMRCFLD(GMRCND),U)):$P(GMRCFLD(GMRCND),U),1:"No Previous Value")
...I GMRCND=7 S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Attention: "_$S($L($P(GMRCFLD(GMRCND),U)):$P(GMRCFLD(GMRCND),U),1:"No Previous Value") Q
...I GMRCND=17 S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Clinically Indicated Date: "_$S($L($P(GMRCFLD(GMRCND),U)):$P(GMRCFLD(GMRCND),U),1:"No Previous Value") ;wat/66/81
...I GMRCND=20 N GMRCND1 S GMRCND1=0,GMRCOUNT=GMRCOUNT+1 D Q
....S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Reason for Request: "
....S GMRCOUNT=GMRCOUNT+1
....F S GMRCND1=$O(@GMRCFLD(20)@(GMRCND1)) Q:GMRCND1="" S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)=@GMRCFLD(20)@(GMRCND1,0),GMRCOUNT=GMRCOUNT+1
...I GMRCND=30 S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Provisional Diagnosis: "_$S($L($P(GMRCFLD(GMRCND),U)):$P(GMRCFLD(GMRCND),U),1:"No Previous Value") Q
...I GMRCND=30.1 S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Provisional Diagnosis Code: "_$S($L($P(GMRCFLD(GMRCND),U)):$P(GMRCFLD(GMRCND),U),1:"No Previous Value") Q
...I GMRCND=30.2 S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Provisional Diagnosis Date: "_$S($L($P(GMRCFLD(GMRCND),U)):$P(GMRCFLD(GMRCND),U),1:"No Previous Value") Q
...I GMRCND=30.3 S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Provisional Diagnosis System: "_$S($L($P(GMRCFLD(GMRCND),U)):$P(GMRCFLD(GMRCND),U),1:"No Previous Value") Q
...I GMRCND=40 S ^GMR(123,+GMRCDA,40,DA,1,GMRCOUNT,0)=$P(GMRCFLD(GMRCND),"^",1) Q
...Q
..Q
.S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)=$$REPEAT^XLFSTR("-",75),GMRCOUNT=GMRCOUNT-1,^GMR(123,+GMRCDA,40,"B",GMRCDT,DA)=""
.S $P(^GMR(123,GMRCDA,40,DA,1,0),"^",3)=GMRCOUNT-1,$P(^(0),"^",4)=GMRCOUNT-1,^GMR(123,+GMRCDA,40,"B",GMRCDT,DA)=""
.Q
K GMRCIND,GMRCND
Q GMRC40DA
;
ADDCM(GMRCO) ;set up to add comment when none exists or to add a new comment
;returns DA for the entry it sets up
N X
S:'$D(^GMR(123,+GMRCO,40,0)) ^(0)="^123.02DA^^" S X=$S($P(^GMR(123,GMRCO,40,0),"^",3):$P(^(0),"^",3)+1,1:1)
S $P(^GMR(123,GMRCO,40,0),"^",3,4)=X_"^"_X
Q X
;
AUDIT0(DA,GMRCDA) ;Add the necessary tracking information to word processing fields
N DIE,DR
S DIE="^GMR(123,"_GMRCDA_",40,",DA(1)=GMRCDA,DR=".01////^S X=$$NOW^XLFDT;1////^S X=GMRCA;2////^S X=$$NOW^XLFDT;3////^S X=DUZ;4////^S X=DUZ"
D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCEDT3 4210 printed Sep 23, 2025@19:21:34 Page 2
GMRCEDT3 ;SLC/DCM,JFR - file edit/resubmit ;12/10/14 14:42
+1 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,15,22,66,73,81**;DEC 27, 1997;Build 6
+2 ;
+3 ;IRCS in use: #2053 (DIE), #2056 (GET1^DIQ), #10103 (XLFDT), #10104 (XLFSTR)
+4 ;
EN(GMRCDA) ;File tracking Data from array
+1 if '$DATA(GMRCGUIF)
WRITE !,"Filing Tracking Data..."
+2 NEW GMRCOUNT,GMRC40DA
+3 SET GMRCDT=$$NOW^XLFDT
+4 SET DIE="^GMR(123,"
SET DA=GMRCDA
SET DR="8////^S X=5"
DO ^DIE
KILL DIE,DA,DR
+5 IF '$DATA(^GMR(123,GMRCDA,40,0))
SET ^GMR(123,GMRCDA,40,0)="123.02^^"
+6 SET DA=$SELECT(+$PIECE(^GMR(123,GMRCDA,40,0),"^",3):$PIECE(^(0),"^",3)+1,1:1)
+7 SET GMRC40DA=DA
+8 SET $PIECE(^GMR(123,GMRCDA,40,0),"^",3,4)=DA_"^"_DA
Begin DoDot:1
+9 SET ^GMR(123,GMRCDA,40,DA,0)=GMRCDT_"^"_$ORDER(^GMR(123.1,"B","EDIT/RESUBMITTED",0))_"^"_GMRCDT_"^"_DUZ_"^"_DUZ
Begin DoDot:2
End DoDot:2
+10 SET ^GMR(123,GMRCDA,40,DA,1,0)="^^^^"_GMRCDT_"^"
Begin DoDot:2
+11 SET GMRCOUNT=1
SET GMRCND=0
SET ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)=$$REPEAT^XLFSTR("-",21)_" PREVIOUS VALUES OF EDITED FIELDS "_$$REPEAT^XLFSTR("-",21)
SET GMRCOUNT=GMRCOUNT+1
+12 IF '$DATA(GMRCFLD)
SET ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="No Fields Were Edited Before Resubmission"
SET GMRCOUNT=GMRCOUNT+1
QUIT
+13 FOR
SET GMRCND=$ORDER(GMRCFLD(GMRCND))
if GMRCND=""
QUIT
Begin DoDot:3
+14 IF GMRCND=.1
SET ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="DISPLAY TEXT OF ITEM ORDERED: "_$PIECE(GMRCFLD(GMRCND),"^",1)
SET GMRCOUNT=GMRCOUNT+1
QUIT
+15 IF GMRCND=1
Begin DoDot:4
+16 SET ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="To Service: "_$SELECT($LENGTH($PIECE(GMRCFLD(GMRCND),U)):$PIECE(GMRCFLD(GMRCND),U),1:"No Previous Value")
+17 QUIT
End DoDot:4
SET GMRCOUNT=GMRCOUNT+1
QUIT
+18 IF GMRCND=4
SET ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Procedure: "_$$GET1^DIQ(123.3,+GMRCFLD(4),.01)
QUIT
+19 IF GMRCND=14
SET ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Performed as Inpt or Outpt: "_$SELECT($LENGTH($PIECE(GMRCFLD(GMRCND),"^")):$PIECE(GMRCFLD(GMRCND),U),1:"No Previous Value")
QUIT
+20 IF $SELECT(GMRCND=5:1,GMRCND=6:1,GMRCND=13:1,1:0)
Begin DoDot:4
+21 NEW CAPTION
SET CAPTION=$SELECT(GMRCND=5:"Urgency: ",GMRCND=6:"Place of Consultation: ",1:"Type of Request: ")
+22 SET ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)=CAPTION_$SELECT($LENGTH($PIECE(GMRCFLD(GMRCND),U)):$PIECE(GMRCFLD(GMRCND),U),1:"No Previous Value")
End DoDot:4
QUIT
+23 IF GMRCND=7
SET ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Attention: "_$SELECT($LENGTH($PIECE(GMRCFLD(GMRCND),U)):$PIECE(GMRCFLD(GMRCND),U),1:"No Previous Value")
QUIT
+24 ;wat/66/81
IF GMRCND=17
SET ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Clinically Indicated Date: "_$SELECT($LENGTH($PIECE(GMRCFLD(GMRCND),U)):$PIECE(GMRCFLD(GMRCND),U),1:"No Previous Value")
+25 IF GMRCND=20
NEW GMRCND1
SET GMRCND1=0
SET GMRCOUNT=GMRCOUNT+1
Begin DoDot:4
+26 SET ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Reason for Request: "
+27 SET GMRCOUNT=GMRCOUNT+1
+28 FOR
SET GMRCND1=$ORDER(@GMRCFLD(20)@(GMRCND1))
if GMRCND1=""
QUIT
SET ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)=@GMRCFLD(20)@(GMRCND1,0)
SET GMRCOUNT=GMRCOUNT+1
End DoDot:4
QUIT
+29 IF GMRCND=30
SET ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Provisional Diagnosis: "_$SELECT($LENGTH($PIECE(GMRCFLD(GMRCND),U)):$PIECE(GMRCFLD(GMRCND),U),1:"No Previous Value")
QUIT
+30 IF GMRCND=30.1
SET ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Provisional Diagnosis Code: "_$SELECT($LENGTH($PIECE(GMRCFLD(GMRCND),U)):$PIECE(GMRCFLD(GMRCND),U),1:"No Previous Value")
QUIT
+31 IF GMRCND=30.2
SET ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Provisional Diagnosis Date: "_$SELECT($LENGTH($PIECE(GMRCFLD(GMRCND),U)):$PIECE(GMRCFLD(GMRCND),U),1:"No Previous Value")
QUIT
+32 IF GMRCND=30.3
SET ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Provisional Diagnosis System: "_$SELECT($LENGTH($PIECE(GMRCFLD(GMRCND),U)):$PIECE(GMRCFLD(GMRCND),U),1:"No Previous Value")
QUIT
+33 IF GMRCND=40
SET ^GMR(123,+GMRCDA,40,DA,1,GMRCOUNT,0)=$PIECE(GMRCFLD(GMRCND),"^",1)
QUIT
+34 QUIT
End DoDot:3
SET GMRCOUNT=GMRCOUNT+1
+35 QUIT
End DoDot:2
+36 SET ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)=$$REPEAT^XLFSTR("-",75)
SET GMRCOUNT=GMRCOUNT-1
SET ^GMR(123,+GMRCDA,40,"B",GMRCDT,DA)=""
+37 SET $PIECE(^GMR(123,GMRCDA,40,DA,1,0),"^",3)=GMRCOUNT-1
SET $PIECE(^(0),"^",4)=GMRCOUNT-1
SET ^GMR(123,+GMRCDA,40,"B",GMRCDT,DA)=""
+38 QUIT
End DoDot:1
+39 KILL GMRCIND,GMRCND
+40 QUIT GMRC40DA
+41 ;
ADDCM(GMRCO) ;set up to add comment when none exists or to add a new comment
+1 ;returns DA for the entry it sets up
+2 NEW X
+3 if '$DATA(^GMR(123,+GMRCO,40,0))
SET ^(0)="^123.02DA^^"
SET X=$SELECT($PIECE(^GMR(123,GMRCO,40,0),"^",3):$PIECE(^(0),"^",3)+1,1:1)
+4 SET $PIECE(^GMR(123,GMRCO,40,0),"^",3,4)=X_"^"_X
+5 QUIT X
+6 ;
AUDIT0(DA,GMRCDA) ;Add the necessary tracking information to word processing fields
+1 NEW DIE,DR
+2 SET DIE="^GMR(123,"_GMRCDA_",40,"
SET DA(1)=GMRCDA
SET DR=".01////^S X=$$NOW^XLFDT;1////^S X=GMRCA;2////^S X=$$NOW^XLFDT;3////^S X=DUZ;4////^S X=DUZ"
+3 DO ^DIE
+4 QUIT
