source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCEDT1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1GMRCEDT1 ;SLC/DCM,JFR - EDIT A CONSULT AND RE-SEND AS NEW ;3/20/03 22:22
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,15,22,33,47**;DEC 27, 1997
3 ;
4 ; This routine invokes IA #2638,#3991
5 ;
6EN(GMRCO) ;GMRCO=IEN of consult from file 123
7 ;GMRCSS=To Service GMRCPROC=Procedure Request Type
8 ;GMRCURG=Urgency GMRCPL=Place Of Consultation
9 ;GMRCATN=Attention GMRCINO=Service is In/Out Patient
10 ;GMRCPNM=Patient Name GMRCDIAG=Provisional Diagnosis
11 N GMRCSS,GMRCPROC,GMRCURG,GMRCPL,GMRCATN,GMRCINO,GMRCDIAG,LN,GMRCRESP
12 K ^TMP("GMRCR",$J,"ED") S GMRCLNO=1
13 I $L($P(^GMR(123,+GMRCO,0),"^",12)) S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=" CURRENT STATUS: (Not Editable): "_$P(^ORD(100.01,$P(^(0),"^",12),0),"^",1),GMRCLNO=GMRCLNO+1
14 S GMRCD=0 F S GMRCD=$O(^GMR(123,+GMRCO,40,"B",GMRCD)) Q:'GMRCD S GMRCDD="" F S GMRCDD=$O(^GMR(123,GMRCO,40,"B",GMRCD,GMRCDD)) Q:'GMRCDD D
15 .I $P(^GMR(123,+GMRCO,40,GMRCDD,0),"^",2)=19 S LN=0 D
16 ..N GMRCPERS,GMRCTX
17 ..I '$D(^GMR(123,+GMRCO,12)) D
18 ...S GMRCPERS=+$P($G(^GMR(123,+GMRCO,40,GMRCDD,0)),"^",5)
19 ...S GMRCPERS=$$GET1^DIQ(200,GMRCPERS,.01)
20 ..I $D(^GMR(123,+GMRCO,12)) D
21 ...I $P(^GMR(123,+GMRCO,12),U,5)="P" D
22 ....S GMRCPERS=$P($G(^GMR(123,+GMRCO,40,GMRCDD,2)),U,1)
23 ...I $P(^GMR(123,+GMRCO,12),U,5)="F" D
24 ....S GMRCPERS=$P($G(^GMR(123,+GMRCO,40,GMRCDD,0)),U,5)
25 ....S GMRCPERS=$$GET1^DIQ(200,GMRCPERS,.01)
26 ..S GMRCTX=" CANCELLED BY (Not Editable): "_GMRCPERS
27 ..S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=GMRCTX,GMRCLNO=GMRCLNO+1
28 ..S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=" CANCELLED COMMENT (Not Editable):",GMRCLNO=GMRCLNO+1
29 ..S LN=$O(^GMR(123,+GMRCO,40,GMRCDD,1,LN)) Q:LN=""!(LN?1A.E) I $L(^GMR(123,+GMRCO,40,GMRCDD,1,LN,0))>75 S FLG=1 D WPSET^GMRCUTIL("^GMR(123,+GMRCO,40,GMRCDD,1)","^TMP(""GMRCR"",$J,""ED"")","",.GMRCLNO,"",FLG)
30 ..I '$D(FLG) S LN=0 F S LN=$O(^GMR(123,+GMRCO,40,GMRCDD,1,LN)) Q:LN=""!(LN?1A.E) S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=^(LN,0),GMRCLNO=GMRCLNO+1
31 ..S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="",$P(^(0),"-",79)=""
32 ..S GMRCLNO=GMRCLNO+1
33 ..Q
34 .Q
35 S GMRCSS=$S($D(GMRCEDT(1)):GMRCEDT(1),1:$P(^GMR(123,+GMRCO,0),"^",5)_U_$P(^GMR(123.5,$P(^GMR(123,+GMRCO,0),"^",5),0),U))
36 S GMRCPROC=$S($D(GMRCED(1)):GMRCED(1),1:$P(^GMR(123,+GMRCO,0),"^",8)_U_$$GET1^DIQ(123.3,+$P(^GMR(123,+GMRCO,0),"^",8),.01))
37 S GMRCURG=$S($D(GMRCED(3)):GMRCED(3),1:$P(^GMR(123,+GMRCO,0),"^",9)_U_$$GET1^DIQ(101,+$P(^(0),"^",9),1))
38 S GMRCPL=$S($D(GMRCED(4)):GMRCED(4),1:$P(^GMR(123,+GMRCO,0),"^",10)_U_$$GET1^DIQ(101,+$P(^(0),U,10),1))
39 S GMRCATN=$S($D(GMRCED(5)):GMRCED(5),1:$P(^GMR(123,+GMRCO,0),"^",11)_U_$$GET1^DIQ(200,+$P(^(0),U,11),.01))
40 I '$D(^GMR(123,GMRCO,30.1)) D
41 . I $D(GMRCED(6)),$L($P(GMRCED(6),U,2)) D Q
42 .. S GMRCDIAG=$P(GMRCED(6),U)_" ("_$P(GMRCED(6),U,2)_")"
43 . S GMRCDIAG=$S($D(GMRCED(6)):GMRCED(6),1:$G(^GMR(123,+GMRCO,30)))
44 I $D(^GMR(123,GMRCO,30.1)) D
45 . I $D(GMRCED(6)),$L(GMRCED(6)) D Q
46 .. S GMRCDIAG=$P(GMRCED(6),U)_" ("_$P(GMRCED(6),U,2)_")"
47 . S GMRCDIAG=$G(^GMR(123,+GMRCO,30))
48 . I '$$STATCHK^ICDAPIU(^GMR(123,GMRCO,30.1),DT) D
49 .. S GMRCDIAG=GMRCDIAG_" <INACTIVE CODE>"
50 I $D(GMRCED(2)) S GMRCINO=GMRCED(2)
51 I '$D(GMRCINO) S GMRCINO=$P(^GMR(123,+GMRCO,0),U,18)_U_$S($P(^(0),U,18)="I":"Inpatient",1:"Outpatient")
52 S GMRCREQ=$S(+$P(^GMR(123,+GMRCO,0),U,17)="P":"Procedure",1:"Consult")
53 S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="SENDING PROVIDER (Not Editable): "_$S($P($G(^GMR(123,+GMRCO,12)),U,6):$P(^GMR(123,+GMRCO,12),U,6),$P(^GMR(123,+GMRCO,0),"^",14):$$GET1^DIQ(200,+$P(^GMR(123,+GMRCO,0),"^",14),.01),1:"UNKNOWN"),GMRCLNO=GMRCLNO+1
54 S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="REQUEST TYPE (Not Editable): "_GMRCREQ,GMRCLNO=GMRCLNO+1
55 S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=$$REPEAT^XLFSTR("-",79),GMRCLNO=GMRCLNO+1
56 S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=" TO SERVICE (Not Editable): "_$P(GMRCSS,U,2) S GMRCLNO=GMRCLNO+1
57 S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=" ",GMRCLNO=GMRCLNO+1
58 S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="1 PROCEDURE: "_$P(GMRCPROC,U,2)
59 D:+GMRCPROC RVRS(GMRCLNO,$D(GMRCED(1))) S GMRCLNO=GMRCLNO+1
60 S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="2 Performed as INPT OR OUTPT: "_$P(GMRCINO,U,2) D RVRS(GMRCLNO,$D(GMRCED(2))) S GMRCLNO=GMRCLNO+1
61 S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="3 URGENCY: "_$P(GMRCURG,U,2) D RVRS(GMRCLNO,$D(GMRCED(3))) S GMRCLNO=GMRCLNO+1
62 S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="4 PLACE OF CONSULTATION: "_$P(GMRCPL,U,2) D RVRS(GMRCLNO,$D(GMRCED(4))) S GMRCLNO=GMRCLNO+1
63 S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="5 ATTENTION (CONSULTANT): "_$P(GMRCATN,U,2) D RVRS(GMRCLNO,$D(GMRCED(5))) S GMRCLNO=GMRCLNO+1
64 S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="6 PROVISIONAL DIAGNOSIS: "_GMRCDIAG D RVRS(GMRCLNO,$D(GMRCED(6))) S GMRCLNO=GMRCLNO+1
65 S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="7 REASON FOR REQUEST:" D RVRS(GMRCLNO,$D(^TMP("GMRCED",$J,20))) S GMRCLNO=GMRCLNO+1 D
66 . I $D(^TMP("GMRCED",$J,20)) D Q
67 .. N ND S ND=0
68 .. F S ND=$O(^TMP("GMRCED",$J,20,ND)) Q:'ND D
69 ... D KILL^VALM10(GMRCLNO)
70 ... S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=^TMP("GMRCED",$J,20,ND,0)
71 ... S GMRCLNO=GMRCLNO+1
72 . N ND S ND=0
73 . F S ND=$O(^GMR(123,+GMRCO,20,ND)) Q:ND="" D
74 .. S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=^GMR(123,+GMRCO,20,ND,0)
75 .. S GMRCLNO=GMRCLNO+1
76 .Q
77 S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="",GMRCLNO=GMRCLNO+1,^TMP("GMRCR",$J,"ED",GMRCLNO,0)="8 COMMENT(S): (Add Only)" D RVRS(GMRCLNO) S GMRCLNO=GMRCLNO+1
78 I $D(^TMP("GMRCED",$J,40)) D
79 . D KILL^VALM10(GMRCLNO)
80 . S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=" New Comment:",GMRCLNO=GMRCLNO+1
81 . N ND S ND=0 F S ND=$O(^TMP("GMRCED",$J,40,ND)) Q:'ND D
82 .. S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=^TMP("GMRCED",$J,40,ND,0)
83 .. S GMRCLNO=GMRCLNO+1
84 N GMRCEDCT
85 S GMRCD=0,GMRCEDCT=0 F S GMRCD=$O(^GMR(123,+GMRCO,40,"B",GMRCD)) Q:'GMRCD S GMRCDD="",GMRCDD=$O(^GMR(123,+GMRCO,40,"B",GMRCD,GMRCDD)) Q:'GMRCDD D
86 .I $P(^GMR(123,+GMRCO,40,GMRCDD,0),"^",2)=20 S LN=0,GMRCEDCT=GMRCEDCT+1,GMRCEDCM(GMRCEDCT)=GMRCDD D
87 ..S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)="",GMRCLNO=GMRCLNO+1,^TMP("GMRCR",$J,"ED",GMRCLNO,0)="ADDED COMMENT (Not Editable) Entered: "_$P($$FMTE^XLFDT($P(^GMR(123,+GMRCO,40,GMRCDD,0),"^",1)),"@",1)
88 ..S GMRCRESP=$S($L($P($G(^GMR(123,+GMRCO,40,GMRCDD,0)),"^",5)):$P(^VA(200,$P(^GMR(123,+GMRCO,40,GMRCDD,0),"^",5),0),"^",1),$L($P($G(^GMR(123,+GMRCO,40,GMRCDD,2)),"^",1)):$P(^GMR(123,+GMRCO,40,GMRCDD,2),"^",1),1:"UNKNOWN")
89 ..S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=^TMP("GMRCR",$J,"ED",GMRCLNO,0)_" BY: "_GMRCRESP,GMRCLNO=GMRCLNO+1
90 ..;S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=^TMP("GMRCR",$J,"ED",GMRCLNO,0)_" BY: "_$S($L($P(^GMR(123,+GMRCO,40,GMRCDD,0),"^",4)):$P(^VA(200,$P(^GMR(123,+GMRCO,40,GMRCDD,0),"^",4),0),"^",1),1:"UNKNOWN"),GMRCLNO=GMRCLNO+1
91 ..S LN=$O(^GMR(123,+GMRCO,40,GMRCDD,1,LN)) Q:LN=""!(LN?1A.E) I $L(^GMR(123,+GMRCO,40,GMRCDD,1,LN,0))>75 S FLG=1 D WPSET^GMRCUTIL("^GMR(123,+GMRCO,40,GMRCDD,1)","^TMP(""GMRCR"",$J,""ED"")","",.GMRCLNO,"",FLG) Q
92 ..S LN=0 F S LN=$O(^GMR(123,+GMRCO,40,GMRCDD,1,LN)) Q:LN=""!(LN?1A.E) S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=^(LN,0),GMRCLNO=GMRCLNO+1
93 ..Q
94 .Q
95 S ^TMP("GMRCR",$J,"ED",GMRCLNO,0)=""
96 K FLG
97 Q
98RVRS(LINE,EDITED) ;reverse video for fields that can be edited
99 I '$G(EDITED) D CNTRL^VALM10(LINE,1,1,IORVON,IORVOFF) Q
100 D CNTRL^VALM10(LINE,1,1,IORVON_IOINHI,IORVOFF_IOINORM)
101 Q
Note: See TracBrowser for help on using the repository browser.