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

GMRCPR0 ; SLC/DLT - Data Entry Promptint actions ;9/8/98  03:59
 ;;3.0;CONSULT/REQUEST TRACKING;**1,5,12,15**;DEC 27, 1997
 ;
 ; This routine invokes IA #2982
 ;
ASK ;ASK FOR TO, PROCEDURE,URGENCY, AND PLACE OF CONSULT
 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
 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
 I '$D(GMRCSRVC) S GMRCSRVC=GMRCSSNM
ASK1 I $L(GMRCWARD) S GMRCIOPT="I"
 E  S GMRCIOPT="O"
 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
 S GMRCIOPT=Y
 I GMRCIOPT="I" S X="GMRCURGENCYM REQ - INPATIENT"
 E  S X="GMRCURGENCYM - OUTPATIENT"
 S DIC=101,DIC(0)="X" D ^DIC K DIC Q:Y<0
 S XQORM("??")="D URGHELP^GMRCPH",XQORM=+Y_";ORD(101,",XQORM(0)="1A\"
 S XQORM("A")="URGENCY: ",XQORM("NO^^")=""
 S GMRCURG1=$G(^DISV(DUZ,"XQORM",XQORM,1)) I '$L(GMRCURG1) K GMRCURG1
 I $D(GMRCURG1) S GMRCURG1=$$UP^XLFSTR(GMRCURG1) I $O(^XUTL("XQORM",XQORM,"B",GMRCURG1,0)) S XQORM("B")=^DISV(DUZ,"XQORM",XQORM,1)
 F  D  Q:Y  I $D(GMRCEND),GMRCEND Q
 .K GMRCURG1
 .D EN^XQORM I X="^"!($D(DIROUT)) S GMRCEND=1 K DIROUT,DTOUT,DUOUT Q
 .I Y<0 S GMRCMSG="The URGENCY is a required response." D EXAC^GMRCADC(GMRCMSG) K GMRCMSG
 .Q
 I $D(GMRCEND),GMRCEND Q
 I $D(Y(1)) S GMRCURG=$P(Y(1),"^",3),GMRCURGI=$P(Y(1),"^",2)
 I GMRCIOPT="I" S X="GMRCPLACEM - INPATIENT"
 E  S X="GMRCPLACEM - OUTPATIENT"
 S DIC=101,DIC(0)="X" D ^DIC Q:Y<0
 K XQORM S XQORM("??")="D PLHELP^GMRCPH",XQORM=+Y_";ORD(101,",XQORM(0)="1A\"
 S XQORM("A")="PLACE OF CONSULTATION: "
 S XQORM("B")=$P($G(^XUTL("XQORM",XQORM,1.1,0)),U,3),XQORM("NO^^")=""
 D EN^XQORM I X="^"!($D(DIROUT)) K XQORM,DIROUT,DTOUT,DUOUT S GMRCEND=1 Q
 I Y<0 D  Q:+$G(GMRCEND)
 .W $C(7),!!,"  The PLACE OF CONSULTATION is a required response!",!
 .D EN^XQORM K XQORM I X="^"!($D(DIROUT))!(Y<1) K DIROUT,DTOUT,DUOUT S GMRCEND=1 Q
 K XQORM I $D(Y(1)) S GMRCPL=$P(Y(1),"^",3),GMRCPLI=$P(Y(1),"^",2)
 Q
TO ;Get Service from File Link field
 S GMRCSS=$P($G(^ORD(101,+GMRCPRI,5)),"^")
 I '+GMRCSS D ASKTO Q:GMRCEND
 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)
 S ORTO=$O(^ORD(100.98,"B","CONSULTS",""))
 Q
ASKTO ;Ask for service when file link not defined in protocol file
 D SERV^GMRCPS I 'GMRCDG S GMRCEND=1 Q
 S GMRCSS=GMRCDG
 Q
PROC ;Use XQORM to select procedure
 S GMRCEND=0 N XQORM
 S DIC=101,X="GMRCRM REQUEST TYPES",DIC(0)="X" D ^DIC Q:Y<0
 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
 D EN^XQORM K XQORM I X="^"!('$L(X))!($D(DIROUT)) S (GMRCQUT,GMRCEND)=1 K DIROUT,DTOUT,DUOUT Q
 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)
 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")
 Q
 ;
GETSVC(SLIST,PROC) ;Get the services that process a procedure type
 N SVC,SCNT
 I '+$G(PROC) Q
 S SCNT=0,SLIST=SCNT
 S SVC=0
 F  S SVC=$O(^GMR(123.3,+PROC,2,"B",SVC)) Q:'SVC  D
 . Q:'$D(^GMR(123.5,+SVC,0))
 . Q:$P(^GMR(123.5,+SVC,0),U,2)=1  ;no groupers
 . Q:$P(^GMR(123.5,+SVC,0),U,2)=9  ;no disabled services
 . S SCNT=SCNT+1
 . S SLIST(SCNT)=SVC_"^"_$P($G(^GMR(123.5,SVC,0)),U,1)
 . Q
 S SLIST=SCNT
 Q