- 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 Feb 18, 2025@23:11:52 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)