source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCUTL1.m@ 1042

Last change on this file since 1042 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1GMRCUTL1 ;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 ;
8ACTM ;;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
15PRNT(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
29END K GMRCDEV,GMRCDEV1,GMRCOREC,GMRCFMT
30 Q
31PROVDX(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
50ORIFN(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)
53GETDT(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 ;
69DCPRNT(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 ;
78PREREQ(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 ;
95LOCKREC(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 ;
114UNLKREC(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
Note: See TracBrowser for help on using the repository browser.