source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCPR0.m@ 1556

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1GMRCPR0 ; SLC/DLT - Data Entry Promptint actions ;9/8/98 03:59
2 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,15**;DEC 27, 1997
3 ;
4 ; This routine invokes IA #2982
5 ;
6ASK ;ASK FOR TO, PROCEDURE,URGENCY, AND PLACE OF CONSULT
7 I $D(GMRCPR),'$D(GMRCPRI) S GMRCPRI=+GMRCPR_";ORD(101,",GMRCORSV=$S(+^ORD(101,+GMRCPR,5):+^(5),1:GMRCSS),GMRCSRVC=$P(^GMR(123.5,GMRCORSV,0),"^",1) K GMRCORSV
8 I $S('$D(GMRCPR):1,GMRCPR="":1,1:0) D PROC Q:GMRCEND S GMRCORSV=^ORD(101,+GMRCPRI,5),GMRCORSV=+GMRCORSV,GMRCSRVC=$P(^GMR(123.5,GMRCORSV,0),"^",1) K GMRCORSV
9 I '$D(GMRCSRVC) S GMRCSRVC=GMRCSSNM
10ASK1 I $L(GMRCWARD) S GMRCIOPT="I"
11 E S GMRCIOPT="O"
12 S DIR(0)="123,14",DIR("A")="Service rendered on (I)npatient or (O)utpatient basis?",DIR("B")=GMRCIOPT D ^DIR K DIR I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) S GMRCEND=1 K DTOUT,DUOUT,DIROUT Q
13 S GMRCIOPT=Y
14 I GMRCIOPT="I" S X="GMRCURGENCYM REQ - INPATIENT"
15 E S X="GMRCURGENCYM - OUTPATIENT"
16 S DIC=101,DIC(0)="X" D ^DIC K DIC Q:Y<0
17 S XQORM("??")="D URGHELP^GMRCPH",XQORM=+Y_";ORD(101,",XQORM(0)="1A\"
18 S XQORM("A")="URGENCY: ",XQORM("NO^^")=""
19 S GMRCURG1=$G(^DISV(DUZ,"XQORM",XQORM,1)) I '$L(GMRCURG1) K GMRCURG1
20 I $D(GMRCURG1) S GMRCURG1=$$UP^XLFSTR(GMRCURG1) I $O(^XUTL("XQORM",XQORM,"B",GMRCURG1,0)) S XQORM("B")=^DISV(DUZ,"XQORM",XQORM,1)
21 F D Q:Y I $D(GMRCEND),GMRCEND Q
22 .K GMRCURG1
23 .D EN^XQORM I X="^"!($D(DIROUT)) S GMRCEND=1 K DIROUT,DTOUT,DUOUT Q
24 .I Y<0 S GMRCMSG="The URGENCY is a required response." D EXAC^GMRCADC(GMRCMSG) K GMRCMSG
25 .Q
26 I $D(GMRCEND),GMRCEND Q
27 I $D(Y(1)) S GMRCURG=$P(Y(1),"^",3),GMRCURGI=$P(Y(1),"^",2)
28 I GMRCIOPT="I" S X="GMRCPLACEM - INPATIENT"
29 E S X="GMRCPLACEM - OUTPATIENT"
30 S DIC=101,DIC(0)="X" D ^DIC Q:Y<0
31 K XQORM S XQORM("??")="D PLHELP^GMRCPH",XQORM=+Y_";ORD(101,",XQORM(0)="1A\"
32 S XQORM("A")="PLACE OF CONSULTATION: "
33 S XQORM("B")=$P($G(^XUTL("XQORM",XQORM,1.1,0)),U,3),XQORM("NO^^")=""
34 D EN^XQORM I X="^"!($D(DIROUT)) K XQORM,DIROUT,DTOUT,DUOUT S GMRCEND=1 Q
35 I Y<0 D Q:+$G(GMRCEND)
36 .W $C(7),!!," The PLACE OF CONSULTATION is a required response!",!
37 .D EN^XQORM K XQORM I X="^"!($D(DIROUT))!(Y<1) K DIROUT,DTOUT,DUOUT S GMRCEND=1 Q
38 K XQORM I $D(Y(1)) S GMRCPL=$P(Y(1),"^",3),GMRCPLI=$P(Y(1),"^",2)
39 Q
40TO ;Get Service from File Link field
41 S GMRCSS=$P($G(^ORD(101,+GMRCPRI,5)),"^")
42 I '+GMRCSS D ASKTO Q:GMRCEND
43 I +GMRCSS S GMRCSS=+GMRCSS,GMRCSSNM=$P($G(^GMR(123.5,GMRCSS,.1)),"^") I '$L(GMRCSSNM) S GMRCSSNM=$P($G(^GMR(123.5,GMRCSS,0)),"^",1)
44 S ORTO=$O(^ORD(100.98,"B","CONSULTS",""))
45 Q
46ASKTO ;Ask for service when file link not defined in protocol file
47 D SERV^GMRCPS I 'GMRCDG S GMRCEND=1 Q
48 S GMRCSS=GMRCDG
49 Q
50PROC ;Use XQORM to select procedure
51 S GMRCEND=0 N XQORM
52 S DIC=101,X="GMRCRM REQUEST TYPES",DIC(0)="X" D ^DIC Q:Y<0
53 S XQORM("??")="D PROCHELP^GMRCPH",XQORM=+Y_";ORD(101,",XQORM(0)="1A\",XQORM("A")="Select PROCEDURE: ",XQORM("NO^^")="" I $D(GMRCPR),$L(GMRCPR) S XQORM("B")=GMRCPR
54 D EN^XQORM K XQORM I X="^"!('$L(X))!($D(DIROUT)) S (GMRCQUT,GMRCEND)=1 K DIROUT,DTOUT,DUOUT Q
55 I $D(Y(1)) S (GMRCVP,GMRCPRI)=$P(Y(1),"^",2)_";ORD(101,",GMRCPR=$S($D(^ORD(101,$P(Y(1),"^",2),.1)):$P(^(.1),"^"),1:"") I '$L(GMRCPR) S GMRCPR=$P(Y(1),"^",3)
56 S X=$S($D(^ORD(101,+GMRCPRI,20)):$P(^(20)," D ",1),1:"") X:X]"" X S GMRCEN=$S($G(GMRCEN)]"":GMRCEN,1:""),GMRCTYPE=$S(GMRCEN="R":"GMRCOR REQUEST",1:"GMRCOR CONSULT")
57 Q
58 ;
59GETSVC(SLIST,PROC) ;Get the services that process a procedure type
60 N SVC,SCNT
61 I '+$G(PROC) Q
62 S SCNT=0,SLIST=SCNT
63 S SVC=0
64 F S SVC=$O(^GMR(123.3,+PROC,2,"B",SVC)) Q:'SVC D
65 . Q:'$D(^GMR(123.5,+SVC,0))
66 . Q:$P(^GMR(123.5,+SVC,0),U,2)=1 ;no groupers
67 . Q:$P(^GMR(123.5,+SVC,0),U,2)=9 ;no disabled services
68 . S SCNT=SCNT+1
69 . S SLIST(SCNT)=SVC_"^"_$P($G(^GMR(123.5,SVC,0)),U,1)
70 . Q
71 S SLIST=SCNT
72 Q
Note: See TracBrowser for help on using the repository browser.