GMRCDRFR ;SLC/JFR - DEFAULT REASON FOR REQUEST UTILS ; 11/12/00 12:00
;;3.0;CONSULT/REQUEST TRACKING;**12,15**;DEC 27, 1997
;
; This routine invokes IA #2876
;
EN ; -- main entry point for GMRC DEFAULT REASON
N GMRCSV,GMRCDFN,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT
S DIR(0)="SOA^S:service;P:procedure"
S DIR("A")="Test default for service or procedure? "
D ^DIR I $D(DIRUT) Q
I Y="S" D SELSS Q:'$D(GMRCSV)
I Y="P" D SELPROC Q:'$D(GMRCPROC)
D SELPT Q:'$D(GMRCPAT)
D INIT
D EN^VALM("GMRC DEFAULT REASON")
Q
;
SELPT ;get new patient
N DIR,X,Y,DIRUT,DUOUT,DTOUT
D FULL^VALM1
S DIR(0)="PO^2:EQM" D ^DIR
I $D(DIRUT) Q
S GMRCPAT=+Y
K ^TMP("GMRCRFR",$J)
Q
;
SELSS ; get new service
N DIR,X,Y,DIRUT,DUOUT,DTOUT
D FULL^VALM1
K GMRCSV,GMRCPROC
S DIR(0)="PO^123.5:EMQ",DIR("A")="Select Service"
D ^DIR
I $D(DIRUT) Q
S GMRCSV=+Y_";99CON"
K ^TMP("GMRCRFR",$J)
Q
;
SELPROC ; get a new procedure
;
N DIR,X,Y,DIRUT,DUOUT,DTOUT
D FULL^VALM1
K GMRCSV,GMRCPROC
S DIR(0)="PO^123.3:EMQ",DIR("A")="Select Procedure"
D ^DIR
I $D(DIRUT) Q
S GMRCPROC=+Y_";99PRC"
K ^TMP("GMRCRFR",$J)
Q
;
HDR ; -- header code
I $D(GMRCPROC) S VALMHDR(1)="Procedure: "_$P(^GMR(123.3,+GMRCPROC,0),U)
I $D(GMRCSV) S VALMHDR(1)="Service: "_$P(^GMR(123.5,+GMRCSV,0),U)
S VALMHDR(2)="Patient: "_$$GET1^DIQ(2,+GMRCPAT,.01)
Q
;
INIT ; -- init variables and list array
Q:$D(^TMP("GMRCRFR",$J))
D GETDEF($NA(^TMP("GMRCRFR",$J)),$S($D(GMRCSV):GMRCSV,1:GMRCPROC),GMRCPAT,1)
I '$D(^TMP("GMRCRFR",$J)) D
. S ^TMP("GMRCRFR",$J,1,0)="No default Reason for Request exists for the selected item."
S VALMCNT=$O(^TMP("GMRCRFR",$J,999999),-1)
S VALMBG=1
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K GMRCSV,GMRCPAT,GMRCPROC
Q
;
EXPND ; -- expand code
Q
;
GETDEF(GMRCARR,GMRCSRV,GMRCDFN,RESOLV) ; return default reason for request
; GMRCARR = array to return containing default RFR
; GMRCSRV = reference to file 123.5 (#;99CON) or file 123.3 (#;99PRC)
; GMRCDFN = patient identifier if to return resolved
; RESOLV = 1 or 0 ; if RESOLV=1 GMRCARR will be returned resolved
Q:'+GMRCSRV
N GMRCFIL
S GMRCFIL=$S(GMRCSRV[";99PRC":123.3,1:123.5)
Q:'$D(^GMR(GMRCFIL,+GMRCSRV,124))
I '$D(GMRCDFN)!('$G(RESOLV)) D Q
. M @GMRCARR=^GMR(GMRCFIL,+GMRCSRV,124)
D BLRPLT^TIUSRVD(,,GMRCDFN,,$NA(^GMR(GMRCFIL,+GMRCSRV,124)))
I $D(^TMP("TIUBOIL",$J)) M @GMRCARR=^TMP("TIUBOIL",$J)
K ^TMP("TIUBOIL",$J)
Q
REAF(GMRCOI) ;return value of RESTRICT DEFAULT REASON EDIT field to CPRS
;Input:
; GMRCOI - ref to file 123.5 (ien;99CON) or file 123.3 (ien;99PRC)
;Output:
; Integer 0 - unrestricted
; 1 - ask on edit only
; 2 - no editing
;
N FILE
S FILE=$S(GMRCOI["99PRC":123.3,1:123.5)
I '$O(^GMR(FILE,+GMRCOI,124,0)) Q 0
I FILE=123.5 Q +$P($G(^GMR(FILE,+GMRCOI,1)),U,3) ;cslt service
Q +$P($G(^GMR(FILE,+GMRCOI,0)),U,9) ;procedure
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCDRFR 2986 printed Apr 09, 2024@20:50:49 Page 2
GMRCDRFR ;SLC/JFR - DEFAULT REASON FOR REQUEST UTILS ; 11/12/00 12:00
+1 ;;3.0;CONSULT/REQUEST TRACKING;**12,15**;DEC 27, 1997
+2 ;
+3 ; This routine invokes IA #2876
+4 ;
EN ; -- main entry point for GMRC DEFAULT REASON
+1 NEW GMRCSV,GMRCDFN,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT
+2 SET DIR(0)="SOA^S:service;P:procedure"
+3 SET DIR("A")="Test default for service or procedure? "
+4 DO ^DIR
IF $DATA(DIRUT)
QUIT
+5 IF Y="S"
DO SELSS
if '$DATA(GMRCSV)
QUIT
+6 IF Y="P"
DO SELPROC
if '$DATA(GMRCPROC)
QUIT
+7 DO SELPT
if '$DATA(GMRCPAT)
QUIT
+8 DO INIT
+9 DO EN^VALM("GMRC DEFAULT REASON")
+10 QUIT
+11 ;
SELPT ;get new patient
+1 NEW DIR,X,Y,DIRUT,DUOUT,DTOUT
+2 DO FULL^VALM1
+3 SET DIR(0)="PO^2:EQM"
DO ^DIR
+4 IF $DATA(DIRUT)
QUIT
+5 SET GMRCPAT=+Y
+6 KILL ^TMP("GMRCRFR",$JOB)
+7 QUIT
+8 ;
SELSS ; get new service
+1 NEW DIR,X,Y,DIRUT,DUOUT,DTOUT
+2 DO FULL^VALM1
+3 KILL GMRCSV,GMRCPROC
+4 SET DIR(0)="PO^123.5:EMQ"
SET DIR("A")="Select Service"
+5 DO ^DIR
+6 IF $DATA(DIRUT)
QUIT
+7 SET GMRCSV=+Y_";99CON"
+8 KILL ^TMP("GMRCRFR",$JOB)
+9 QUIT
+10 ;
SELPROC ; get a new procedure
+1 ;
+2 NEW DIR,X,Y,DIRUT,DUOUT,DTOUT
+3 DO FULL^VALM1
+4 KILL GMRCSV,GMRCPROC
+5 SET DIR(0)="PO^123.3:EMQ"
SET DIR("A")="Select Procedure"
+6 DO ^DIR
+7 IF $DATA(DIRUT)
QUIT
+8 SET GMRCPROC=+Y_";99PRC"
+9 KILL ^TMP("GMRCRFR",$JOB)
+10 QUIT
+11 ;
HDR ; -- header code
+1 IF $DATA(GMRCPROC)
SET VALMHDR(1)="Procedure: "_$PIECE(^GMR(123.3,+GMRCPROC,0),U)
+2 IF $DATA(GMRCSV)
SET VALMHDR(1)="Service: "_$PIECE(^GMR(123.5,+GMRCSV,0),U)
+3 SET VALMHDR(2)="Patient: "_$$GET1^DIQ(2,+GMRCPAT,.01)
+4 QUIT
+5 ;
INIT ; -- init variables and list array
+1 if $DATA(^TMP("GMRCRFR",$JOB))
QUIT
+2 DO GETDEF($NAME(^TMP("GMRCRFR",$JOB)),$SELECT($DATA(GMRCSV):GMRCSV,1:GMRCPROC),GMRCPAT,1)
+3 IF '$DATA(^TMP("GMRCRFR",$JOB))
Begin DoDot:1
+4 SET ^TMP("GMRCRFR",$JOB,1,0)="No default Reason for Request exists for the selected item."
End DoDot:1
+5 SET VALMCNT=$ORDER(^TMP("GMRCRFR",$JOB,999999),-1)
+6 SET VALMBG=1
+7 QUIT
+8 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL GMRCSV,GMRCPAT,GMRCPROC
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
GETDEF(GMRCARR,GMRCSRV,GMRCDFN,RESOLV) ; return default reason for request
+1 ; GMRCARR = array to return containing default RFR
+2 ; GMRCSRV = reference to file 123.5 (#;99CON) or file 123.3 (#;99PRC)
+3 ; GMRCDFN = patient identifier if to return resolved
+4 ; RESOLV = 1 or 0 ; if RESOLV=1 GMRCARR will be returned resolved
+5 if '+GMRCSRV
QUIT
+6 NEW GMRCFIL
+7 SET GMRCFIL=$SELECT(GMRCSRV[";99PRC":123.3,1:123.5)
+8 if '$DATA(^GMR(GMRCFIL,+GMRCSRV,124))
QUIT
+9 IF '$DATA(GMRCDFN)!('$GET(RESOLV))
Begin DoDot:1
+10 MERGE @GMRCARR=^GMR(GMRCFIL,+GMRCSRV,124)
End DoDot:1
QUIT
+11 DO BLRPLT^TIUSRVD(,,GMRCDFN,,$NAME(^GMR(GMRCFIL,+GMRCSRV,124)))
+12 IF $DATA(^TMP("TIUBOIL",$JOB))
MERGE @GMRCARR=^TMP("TIUBOIL",$JOB)
+13 KILL ^TMP("TIUBOIL",$JOB)
+14 QUIT
REAF(GMRCOI) ;return value of RESTRICT DEFAULT REASON EDIT field to CPRS
+1 ;Input:
+2 ; GMRCOI - ref to file 123.5 (ien;99CON) or file 123.3 (ien;99PRC)
+3 ;Output:
+4 ; Integer 0 - unrestricted
+5 ; 1 - ask on edit only
+6 ; 2 - no editing
+7 ;
+8 NEW FILE
+9 SET FILE=$SELECT(GMRCOI["99PRC":123.3,1:123.5)
+10 IF '$ORDER(^GMR(FILE,+GMRCOI,124,0))
QUIT 0
+11 ;cslt service
IF FILE=123.5
QUIT +$PIECE($GET(^GMR(FILE,+GMRCOI,1)),U,3)
+12 ;procedure
QUIT +$PIECE($GET(^GMR(FILE,+GMRCOI,0)),U,9)
