source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCEDT3.m@ 1123

GMRCEDT3 ;SLC/DCM,JFR - file edit/resubmit ;1/16/02 19:28
 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,15,22**;DEC 27, 1997
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=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=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