| [613] | 1 | GMRCDRFR ;SLC/JFR - DEFAULT REASON FOR REQUEST UTILS ; 11/12/00 12:00
|
|---|
| 2 | ;;3.0;CONSULT/REQUEST TRACKING;**12,15**;DEC 27, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine invokes IA #2876
|
|---|
| 5 | ;
|
|---|
| 6 | EN ; -- main entry point for GMRC DEFAULT REASON
|
|---|
| 7 | N GMRCSV,GMRCDFN,DIR,X,Y,DUOUT,DTOUT,DIROUT,DIRUT
|
|---|
| 8 | S DIR(0)="SOA^S:service;P:procedure"
|
|---|
| 9 | S DIR("A")="Test default for service or procedure? "
|
|---|
| 10 | D ^DIR I $D(DIRUT) Q
|
|---|
| 11 | I Y="S" D SELSS Q:'$D(GMRCSV)
|
|---|
| 12 | I Y="P" D SELPROC Q:'$D(GMRCPROC)
|
|---|
| 13 | D SELPT Q:'$D(GMRCPAT)
|
|---|
| 14 | D INIT
|
|---|
| 15 | D EN^VALM("GMRC DEFAULT REASON")
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | SELPT ;get new patient
|
|---|
| 19 | N DIR,X,Y,DIRUT,DUOUT,DTOUT
|
|---|
| 20 | D FULL^VALM1
|
|---|
| 21 | S DIR(0)="PO^2:EQM" D ^DIR
|
|---|
| 22 | I $D(DIRUT) Q
|
|---|
| 23 | S GMRCPAT=+Y
|
|---|
| 24 | K ^TMP("GMRCRFR",$J)
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | SELSS ; get new service
|
|---|
| 28 | N DIR,X,Y,DIRUT,DUOUT,DTOUT
|
|---|
| 29 | D FULL^VALM1
|
|---|
| 30 | K GMRCSV,GMRCPROC
|
|---|
| 31 | S DIR(0)="PO^123.5:EMQ",DIR("A")="Select Service"
|
|---|
| 32 | D ^DIR
|
|---|
| 33 | I $D(DIRUT) Q
|
|---|
| 34 | S GMRCSV=+Y_";99CON"
|
|---|
| 35 | K ^TMP("GMRCRFR",$J)
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | SELPROC ; get a new procedure
|
|---|
| 39 | ;
|
|---|
| 40 | N DIR,X,Y,DIRUT,DUOUT,DTOUT
|
|---|
| 41 | D FULL^VALM1
|
|---|
| 42 | K GMRCSV,GMRCPROC
|
|---|
| 43 | S DIR(0)="PO^123.3:EMQ",DIR("A")="Select Procedure"
|
|---|
| 44 | D ^DIR
|
|---|
| 45 | I $D(DIRUT) Q
|
|---|
| 46 | S GMRCPROC=+Y_";99PRC"
|
|---|
| 47 | K ^TMP("GMRCRFR",$J)
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | HDR ; -- header code
|
|---|
| 51 | I $D(GMRCPROC) S VALMHDR(1)="Procedure: "_$P(^GMR(123.3,+GMRCPROC,0),U)
|
|---|
| 52 | I $D(GMRCSV) S VALMHDR(1)="Service: "_$P(^GMR(123.5,+GMRCSV,0),U)
|
|---|
| 53 | S VALMHDR(2)="Patient: "_$$GET1^DIQ(2,+GMRCPAT,.01)
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | INIT ; -- init variables and list array
|
|---|
| 57 | Q:$D(^TMP("GMRCRFR",$J))
|
|---|
| 58 | D GETDEF($NA(^TMP("GMRCRFR",$J)),$S($D(GMRCSV):GMRCSV,1:GMRCPROC),GMRCPAT,1)
|
|---|
| 59 | I '$D(^TMP("GMRCRFR",$J)) D
|
|---|
| 60 | . S ^TMP("GMRCRFR",$J,1,0)="No default Reason for Request exists for the selected item."
|
|---|
| 61 | S VALMCNT=$O(^TMP("GMRCRFR",$J,999999),-1)
|
|---|
| 62 | S VALMBG=1
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | HELP ; -- help code
|
|---|
| 66 | S X="?" D DISP^XQORM1 W !!
|
|---|
| 67 | Q
|
|---|
| 68 | ;
|
|---|
| 69 | EXIT ; -- exit code
|
|---|
| 70 | K GMRCSV,GMRCPAT,GMRCPROC
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | EXPND ; -- expand code
|
|---|
| 74 | Q
|
|---|
| 75 | ;
|
|---|
| 76 | GETDEF(GMRCARR,GMRCSRV,GMRCDFN,RESOLV) ; return default reason for request
|
|---|
| 77 | ; GMRCARR = array to return containing default RFR
|
|---|
| 78 | ; GMRCSRV = reference to file 123.5 (#;99CON) or file 123.3 (#;99PRC)
|
|---|
| 79 | ; GMRCDFN = patient identifier if to return resolved
|
|---|
| 80 | ; RESOLV = 1 or 0 ; if RESOLV=1 GMRCARR will be returned resolved
|
|---|
| 81 | Q:'+GMRCSRV
|
|---|
| 82 | N GMRCFIL
|
|---|
| 83 | S GMRCFIL=$S(GMRCSRV[";99PRC":123.3,1:123.5)
|
|---|
| 84 | Q:'$D(^GMR(GMRCFIL,+GMRCSRV,124))
|
|---|
| 85 | I '$D(GMRCDFN)!('$G(RESOLV)) D Q
|
|---|
| 86 | . M @GMRCARR=^GMR(GMRCFIL,+GMRCSRV,124)
|
|---|
| 87 | D BLRPLT^TIUSRVD(,,GMRCDFN,,$NA(^GMR(GMRCFIL,+GMRCSRV,124)))
|
|---|
| 88 | I $D(^TMP("TIUBOIL",$J)) M @GMRCARR=^TMP("TIUBOIL",$J)
|
|---|
| 89 | K ^TMP("TIUBOIL",$J)
|
|---|
| 90 | Q
|
|---|
| 91 | REAF(GMRCOI) ;return value of RESTRICT DEFAULT REASON EDIT field to CPRS
|
|---|
| 92 | ;Input:
|
|---|
| 93 | ; GMRCOI - ref to file 123.5 (ien;99CON) or file 123.3 (ien;99PRC)
|
|---|
| 94 | ;Output:
|
|---|
| 95 | ; Integer 0 - unrestricted
|
|---|
| 96 | ; 1 - ask on edit only
|
|---|
| 97 | ; 2 - no editing
|
|---|
| 98 | ;
|
|---|
| 99 | N FILE
|
|---|
| 100 | S FILE=$S(GMRCOI["99PRC":123.3,1:123.5)
|
|---|
| 101 | I '$O(^GMR(FILE,+GMRCOI,124,0)) Q 0
|
|---|
| 102 | I FILE=123.5 Q +$P($G(^GMR(FILE,+GMRCOI,1)),U,3) ;cslt service
|
|---|
| 103 | Q +$P($G(^GMR(FILE,+GMRCOI,0)),U,9) ;procedure
|
|---|
