source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCEDT3.m@ 1076

Last change on this file since 1076 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1GMRCEDT3 ;SLC/DCM,JFR - file edit/resubmit ;1/16/02 19:28
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,15,22**;DEC 27, 1997
3EN(GMRCDA) ;File tracking Data from array
4 W:'$D(GMRCGUIF) !,"Filing Tracking Data..."
5 N GMRCOUNT,GMRC40DA
6 S GMRCDT=$$NOW^XLFDT
7 S DIE="^GMR(123,",DA=GMRCDA,DR="8////^S X=5" D ^DIE K DIE,DA,DR
8 I '$D(^GMR(123,GMRCDA,40,0)) S ^GMR(123,GMRCDA,40,0)="123.02^^"
9 S DA=$S(+$P(^GMR(123,GMRCDA,40,0),"^",3):$P(^(0),"^",3)+1,1:1)
10 S GMRC40DA=DA
11 S $P(^GMR(123,GMRCDA,40,0),"^",3,4)=DA_"^"_DA D
12 .S ^GMR(123,GMRCDA,40,DA,0)=GMRCDT_"^"_$O(^GMR(123.1,"B","EDIT/RESUBMITTED",0))_"^"_GMRCDT_"^"_DUZ_"^"_DUZ D
13 .S ^GMR(123,GMRCDA,40,DA,1,0)="^^^^"_GMRCDT_"^" D
14 ..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
15 ..I '$D(GMRCFLD) S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="No Fields Were Edited Before Resubmission",GMRCOUNT=GMRCOUNT+1 Q
16 ..F S GMRCND=$O(GMRCFLD(GMRCND)) Q:GMRCND="" D S GMRCOUNT=GMRCOUNT+1
17 ...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
18 ...I GMRCND=1 D S GMRCOUNT=GMRCOUNT+1 Q
19 ....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")
20 ....Q
21 ...I GMRCND=4 S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Procedure: "_$$GET1^DIQ(123.3,+GMRCFLD(4),.01) Q
22 ...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
23 ...I $S(GMRCND=5:1,GMRCND=6:1,GMRCND=13:1,1:0) D Q
24 ....N CAPTION S CAPTION=$S(GMRCND=5:"Urgency: ",GMRCND=6:"Place of Consultation: ",1:"Type of Request: ")
25 ....S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)=CAPTION_$S($L($P(GMRCFLD(GMRCND),U)):$P(GMRCFLD(GMRCND),U),1:"No Previous Value")
26 ...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
27 ...I GMRCND=20 N GMRCND1 S GMRCND1=0,GMRCOUNT=GMRCOUNT+1 D Q
28 ....S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)="Reason for Request: "
29 ....S GMRCOUNT=GMRCOUNT+1
30 ....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
31 ...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
32 ...I GMRCND=40 S ^GMR(123,+GMRCDA,40,DA,1,GMRCOUNT,0)=$P(GMRCFLD(GMRCND),"^",1) Q
33 ...Q
34 ..Q
35 .S ^GMR(123,GMRCDA,40,DA,1,GMRCOUNT,0)=$$REPEAT^XLFSTR("-",75),GMRCOUNT=GMRCOUNT-1,^GMR(123,+GMRCDA,40,"B",GMRCDT,DA)=""
36 .S $P(^GMR(123,GMRCDA,40,DA,1,0),"^",3)=GMRCOUNT-1,$P(^(0),"^",4)=GMRCOUNT-1,^GMR(123,+GMRCDA,40,"B",GMRCDT,DA)=""
37 .Q
38 K GMRCIND,GMRCND
39 Q GMRC40DA
40 ;
41ADDCM(GMRCO) ;set up to add comment when none exists or to add a new comment
42 ;returns DA for the entry it sets up
43 N X
44 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)
45 S $P(^GMR(123,GMRCO,40,0),"^",3,4)=X_"^"_X
46 Q X
47 ;
48AUDIT0(DA,GMRCDA) ;Add the necessary tracking information to word processing fields
49 N DIE,DR
50 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"
51 D ^DIE
52 Q
Note: See TracBrowser for help on using the repository browser.