- 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 Mar 13, 2025@20:50:13 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
