| 1 | GMRCUTL1 ;SLC/DCM,JFR,MA - General Utilities ;10/15/02 11:49
|
|---|
| 2 | ;;3.0;CONSULT/REQUEST TRACKING;**1,4,12,15,21,17,28**;DEC 27, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine invokes IA #2876,3121
|
|---|
| 5 | ; Patch #21 added variable GMRCAUDT and moved line tag PRNTAUDT
|
|---|
| 6 | ; to GMRCP5A.
|
|---|
| 7 | ;
|
|---|
| 8 | ACTM ;;Set correct variables to complete, discontinue, etc. a consult
|
|---|
| 9 | K GMRCQUT
|
|---|
| 10 | S:'+$G(GMRCA) GMRCA=$O(^GMR(123.1,"B",GMRCACTM,""))
|
|---|
| 11 | S GMRCACTM=$P($G(^GMR(123.1,+GMRCA,0)),"^")
|
|---|
| 12 | S ORSTS=$S(GMRCA:$P(^GMR(123.1,GMRCA,0),"^",2),1:0)
|
|---|
| 13 | I 'GMRCA S GMRCQUT=1
|
|---|
| 14 | Q
|
|---|
| 15 | PRNT(SRVCIFN,GMRCO) ;print form 513 to a printer when new consult is entered
|
|---|
| 16 | N ORVP,GMRCDEV,GMRCQUED,IOP,%ZIS,POP,ZTDTH,ZTDESC,ZTIO,ZTRTN,ZTSK,GMRCAUDT
|
|---|
| 17 | I '$G(SRVCIFN) S SRVCIFN=+$P(^GMR(123,GMRCO,0),U,5)
|
|---|
| 18 | Q:'$D(^GMR(123.5,SRVCIFN,123)) Q:'$P(^GMR(123.5,SRVCIFN,123),"^",9)
|
|---|
| 19 | S IOP="`"_$P(^GMR(123.5,SRVCIFN,123),"^",9)
|
|---|
| 20 | S %ZIS="N" D ^%ZIS I POP S %ZIS=0 D HOME^%ZIS Q
|
|---|
| 21 | S GMRCDEV=ION,GMRCQUED=1,GMRCAUDT=1
|
|---|
| 22 | S ZTRTN="PRNT^GMRCP5A("_(+GMRCO)_","_(+$G(TIUFLG))_",1,"""_$G(GMRCCPY,"W")_""",0,"_(GMRCAUDT)_")"
|
|---|
| 23 | S ZTDESC="CONSULT/REQUEST PACKAGE PRINT FORM 513 FOR NEW CONSULT"
|
|---|
| 24 | S ZTIO=GMRCDEV,ZTDTH=$H
|
|---|
| 25 | D ^%ZTLOAD
|
|---|
| 26 | S %ZIS=0 D HOME^%ZIS
|
|---|
| 27 | K GMRCQUED,GMRCDEV1
|
|---|
| 28 | Q
|
|---|
| 29 | END K GMRCDEV,GMRCDEV1,GMRCOREC,GMRCFMT
|
|---|
| 30 | Q
|
|---|
| 31 | PROVDX(OI) ;return PROV DX prompting info from 123.5
|
|---|
| 32 | ; Input:
|
|---|
| 33 | ; OI = ref to file 123.5("#;99CON") or file 123.3 (#;99PRC)
|
|---|
| 34 | ;
|
|---|
| 35 | ; Returns: string A^B
|
|---|
| 36 | ; A = O (optional), R (required) or S (suppress)
|
|---|
| 37 | ; B = F (free-text) or L (lexicon)
|
|---|
| 38 | ;
|
|---|
| 39 | N GMRCFIL
|
|---|
| 40 | Q:'+$G(OI) "^"
|
|---|
| 41 | S GMRCFIL=$S(OI["99PRC":123.3,1:123.5)
|
|---|
| 42 | Q:'$D(^GMR(GMRCFIL,+OI)) "^"
|
|---|
| 43 | N STRING,NODE
|
|---|
| 44 | I GMRCFIL=123.3 S NODE=$P(^GMR(123.3,+OI,0),U,7,8)
|
|---|
| 45 | I GMRCFIL=123.5 S NODE=$P($G(^GMR(123.5,+OI,1)),U,1,2)
|
|---|
| 46 | I NODE="" Q "O^F" ;values not set
|
|---|
| 47 | S $P(STRING,U)=$S($L($P(NODE,U)):$P(NODE,U),1:"O")
|
|---|
| 48 | S $P(STRING,U,2)=$S($L($P(NODE,U,2)):$P(NODE,U,2),1:"F")
|
|---|
| 49 | Q STRING
|
|---|
| 50 | ORIFN(GMRC123) ;return ORIFN associated with give record in ^GMR(123,
|
|---|
| 51 | ; GMRC123 = ien of consult record in file 123
|
|---|
| 52 | Q $P($G(^GMR(123,GMRC123,0)),U,3)
|
|---|
| 53 | GETDT(PROMPT,DEFAULT) ;prompt and return FM date
|
|---|
| 54 | ;Input:
|
|---|
| 55 | ; PROMPT = text of prompt - DIR("A") (optional)
|
|---|
| 56 | ; DEFAULT = default date to prompt - DIR("B") (optional)
|
|---|
| 57 | ;
|
|---|
| 58 | ;Output:
|
|---|
| 59 | ; FM date/time if successfully answered, "^" if exit or timeout
|
|---|
| 60 | N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
|
|---|
| 61 | S DIR(0)="DA^::EPT"
|
|---|
| 62 | S DIR("?")="Enter the date/time the activity took place."
|
|---|
| 63 | S DIR("A")=$S($D(PROMPT):PROMPT_" ",1:"Actual Date/Time of Activity: ")
|
|---|
| 64 | S DIR("B")=$S($D(DEFAULT):DEFAULT,1:"NOW")
|
|---|
| 65 | D ^DIR
|
|---|
| 66 | I $D(DUOUT)!($D(DTOUT)) S Y="^"
|
|---|
| 67 | Q Y
|
|---|
| 68 | ;
|
|---|
| 69 | DCPRNT(IEN,USER) ;reprint SF-513 on DC?
|
|---|
| 70 | N SERV,REPR
|
|---|
| 71 | S SERV=$P(^GMR(123,IEN,0),U,5) I 'SERV Q 0
|
|---|
| 72 | S REPR=$P($G(^GMR(123.5,SERV,1)),U,5)
|
|---|
| 73 | I 'REPR Q 1
|
|---|
| 74 | I REPR=2 Q 0
|
|---|
| 75 | I REPR=1,'$$VALID^GMRCAU(SERV,IEN,USER) Q 1
|
|---|
| 76 | Q 0
|
|---|
| 77 | ;
|
|---|
| 78 | PREREQ(GMRCARR,GMRCSRV,GMRCDFN,UNRESOLV) ; return service pre-requisite
|
|---|
| 79 | ; pre-requisite stored in 125 nodes in file 123.5 or 123.3
|
|---|
| 80 | ; GMRCARR = array to return containing pre-requisite
|
|---|
| 81 | ; GMRCSRV = ref to file 123.5 (ien;99CON) or 123.3 (ien;99PRC)
|
|---|
| 82 | ; GMRCDFN = patient identifier if to return resolved
|
|---|
| 83 | ; UNRESOLV = 1 or 0 ; if UNRESOLV=1 GMRCARR will be returned unresolved
|
|---|
| 84 | Q:'+GMRCSRV
|
|---|
| 85 | N GMRCFIL
|
|---|
| 86 | S GMRCFIL=$S(GMRCSRV["99PRC":123.3,1:123.5)
|
|---|
| 87 | Q:'$D(^GMR(GMRCFIL,+GMRCSRV,125))
|
|---|
| 88 | I '$D(GMRCDFN)!($G(UNRESOLV)) D Q
|
|---|
| 89 | . M @GMRCARR=^GMR(GMRCFIL,+GMRCSRV,125)
|
|---|
| 90 | D BLRPLT^TIUSRVD(,,GMRCDFN,,$NA(^GMR(GMRCFIL,+GMRCSRV,125)))
|
|---|
| 91 | I $D(^TMP("TIUBOIL",$J)) M @GMRCARR=^TMP("TIUBOIL",$J)
|
|---|
| 92 | K ^TMP("TIUBOIL",$J)
|
|---|
| 93 | Q
|
|---|
| 94 | ;
|
|---|
| 95 | LOCKREC(GMRCDA) ;attempt to lock a consult record using order or record
|
|---|
| 96 | ; Input:
|
|---|
| 97 | ; GMRCDA = ien of consult record from file 123
|
|---|
| 98 | ;
|
|---|
| 99 | ; Output:
|
|---|
| 100 | ; 1 or 0^reason can't be locked
|
|---|
| 101 | ; 1 = successfully locked
|
|---|
| 102 | ; 0 = couldn't be locked
|
|---|
| 103 | N GMRCORD,GMRCMSG
|
|---|
| 104 | S GMRCORD=$P($G(^GMR(123,GMRCDA,0)),U,3)
|
|---|
| 105 | I $G(GMRCORD) D ;an order associated
|
|---|
| 106 | . S GMRCMSG=$$LOCK1^ORX2(GMRCORD)
|
|---|
| 107 | . ; GMRCMSG=1 if locked or 0 if couldn't be locked
|
|---|
| 108 | I $L($G(GMRCMSG)) Q GMRCMSG
|
|---|
| 109 | ; no order = Inter-facility Consult so lock consult record
|
|---|
| 110 | L +^GMR(123,GMRCDA):5
|
|---|
| 111 | I '$T Q "0^Another user is editing this record" ; couldn't lock it
|
|---|
| 112 | Q 1
|
|---|
| 113 | ;
|
|---|
| 114 | UNLKREC(GMRCDA) ;unlock a consult record
|
|---|
| 115 | ; Input:
|
|---|
| 116 | ; GMRCDA = ien of consult record from file 123
|
|---|
| 117 | ;
|
|---|
| 118 | N GMRCORD
|
|---|
| 119 | S GMRCORD=$P($G(^GMR(123,GMRCDA,0)),U,3)
|
|---|
| 120 | I $G(GMRCORD) D Q
|
|---|
| 121 | . D UNLK1^ORX2(GMRCORD)
|
|---|
| 122 | L -^GMR(123,GMRCDA)
|
|---|
| 123 | Q
|
|---|
