Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCUTL1

GMRCUTL1.m

Go to the documentation of this file. 
  1. GMRCUTL1 ;SLC/DCM,JFR,MA - General Utilities ;12-Feb-2015 15:20;DU
  1.  ;;3.0;CONSULT/REQUEST TRACKING;**1,4,12,15,21,17,28,1004,1005**;DEC 27, 1997;Build 2
  1.  ;
  1.  ; This routine invokes IA #2876,3121
  1.  ; Patch #21 added variable GMRCAUDT and moved line tag PRNTAUDT
  1.  ; to GMRCP5A.
  1.  ;
  1. ACTM ;;Set correct variables to complete, discontinue, etc. a consult
  1.  K GMRCQUT
  1.  S:'+$G(GMRCA) GMRCA=$O(^GMR(123.1,"B",GMRCACTM,""))
  1.  S GMRCACTM=$P($G(^GMR(123.1,+GMRCA,0)),"^")
  1.  S ORSTS=$S(GMRCA:$P(^GMR(123.1,GMRCA,0),"^",2),1:0)
  1.  I 'GMRCA S GMRCQUT=1
  1.  Q
  1. PRNT(SRVCIFN,GMRCO) ;print form 513 to a printer when new consult is entered
  1.  N ORVP,GMRCDEV,GMRCQUED,IOP,%ZIS,POP,ZTDTH,ZTDESC,ZTIO,ZTRTN,ZTSK,GMRCAUDT
  1.  I '$G(SRVCIFN) S SRVCIFN=+$P(^GMR(123,GMRCO,0),U,5)
  1.  Q:'$D(^GMR(123.5,SRVCIFN,123))  Q:'$P(^GMR(123.5,SRVCIFN,123),"^",9)
  1.  S IOP="`"_$P(^GMR(123.5,SRVCIFN,123),"^",9)
  1.  S %ZIS="N" D ^%ZIS I POP S %ZIS=0 D HOME^%ZIS Q
  1.  S GMRCDEV=ION,GMRCQUED=1,GMRCAUDT=1
  1.  S ZTRTN="PRNT^GMRCP5A("_(+GMRCO)_","_(+$G(TIUFLG))_",1,"""_$G(GMRCCPY,"W")_""",0,"_(GMRCAUDT)_")"
  1.  S ZTDESC="CONSULT/REQUEST PACKAGE PRINT FORM 513 FOR NEW CONSULT"
  1.  S ZTIO=GMRCDEV,ZTDTH=$H
  1.  D ^%ZTLOAD
  1.  S %ZIS=0 D HOME^%ZIS
  1.  K GMRCQUED,GMRCDEV1
  1.  Q
  1. END K GMRCDEV,GMRCDEV1,GMRCOREC,GMRCFMT
  1.  Q
  1. PROVDX(OI) ;return PROV DX prompting info from 123.5
  1.  ;    Input:
  1.  ;       OI = ref to file 123.5("#;99CON") or file 123.3 (#;99PRC)
  1.  ;
  1.  ;    Returns:  string  A^B
  1.  ;       A = O (optional), R (required) or S (suppress)
  1.  ;       B = F (free-text) or L (lexicon)
  1.  ;
  1.  N GMRCFIL
  1.  Q:'+$G(OI) "^"
  1.  S GMRCFIL=$S(OI["99PRC":123.3,1:123.5)
  1.  Q:'$D(^GMR(GMRCFIL,+OI)) "^"
  1.  N STRING,NODE,DATA
  1.  I GMRCFIL=123.3 S NODE=$P(^GMR(123.3,+OI,0),U,7,8)
  1.  I GMRCFIL=123.5 S NODE=$P($G(^GMR(123.5,+OI,1)),U,1,2)
  1.  ;IHS/MSC/MGH patch 1005 check for parameter being turned off
  1.  D GETPAR^CIAVMRPC(.DATA,"BEHOORPA CLINICAL INDICATOR","ALL","CONSULT/REQUEST TRACKING")
  1.  I DATA=0 Q "O^F"  ;Parameter is not turned on
  1.  I NODE="" Q "R^F" ;values not set
  1.  S $P(STRING,U)=$S($L($P(NODE,U)):$P(NODE,U),1:"R")
  1.  S $P(STRING,U,2)=$S($L($P(NODE,U,2)):$P(NODE,U,2),1:"F")
  1.  Q STRING
  1. ORIFN(GMRC123) ;return ORIFN associated with give record in ^GMR(123,
  1.  ; GMRC123 = ien of consult record in file 123
  1.  Q $P($G(^GMR(123,GMRC123,0)),U,3)
  1. GETDT(PROMPT,DEFAULT) ;prompt and return FM date
  1.  ;Input:
  1.  ;  PROMPT  = text of prompt - DIR("A")          (optional)
  1.  ;  DEFAULT = default date to prompt - DIR("B")  (optional)
  1.  ;
  1.  ;Output:
  1.  ; FM date/time if successfully answered, "^" if exit or timeout
  1.  N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="DA^::EPT"
  1.  S DIR("?")="Enter the date/time the activity took place."
  1.  S DIR("A")=$S($D(PROMPT):PROMPT_" ",1:"Actual Date/Time of Activity: ")
  1.  S DIR("B")=$S($D(DEFAULT):DEFAULT,1:"NOW")
  1.  D ^DIR
  1.  I $D(DUOUT)!($D(DTOUT)) S Y="^"
  1.  Q Y
  1.  ;
  1. DCPRNT(IEN,USER) ;reprint SF-513 on DC?
  1.  N SERV,REPR
  1.  S SERV=$P(^GMR(123,IEN,0),U,5) I 'SERV Q 0
  1.  S REPR=$P($G(^GMR(123.5,SERV,1)),U,5)
  1.  I 'REPR Q 1
  1.  I REPR=2 Q 0
  1.  I REPR=1,'$$VALID^GMRCAU(SERV,IEN,USER) Q 1
  1.  Q 0
  1.  ;
  1. PREREQ(GMRCARR,GMRCSRV,GMRCDFN,UNRESOLV) ; return service pre-requisite
  1.  ; pre-requisite stored in 125 nodes in file 123.5 or 123.3
  1.  ; GMRCARR = array to return containing pre-requisite
  1.  ; GMRCSRV = ref to file 123.5 (ien;99CON) or 123.3 (ien;99PRC)
  1.  ; GMRCDFN = patient identifier if to return resolved
  1.  ; UNRESOLV = 1 or 0 ; if UNRESOLV=1 GMRCARR will be returned unresolved
  1.  Q:'+GMRCSRV
  1.  N GMRCFIL
  1.  S GMRCFIL=$S(GMRCSRV["99PRC":123.3,1:123.5)
  1.  Q:'$D(^GMR(GMRCFIL,+GMRCSRV,125))
  1.  I '$D(GMRCDFN)!($G(UNRESOLV)) D  Q
  1.  . M @GMRCARR=^GMR(GMRCFIL,+GMRCSRV,125)
  1.  D BLRPLT^TIUSRVD(,,GMRCDFN,,$NA(^GMR(GMRCFIL,+GMRCSRV,125)))
  1.  I $D(^TMP("TIUBOIL",$J)) M @GMRCARR=^TMP("TIUBOIL",$J)
  1.  K ^TMP("TIUBOIL",$J)
  1.  Q
  1.  ;
  1. LOCKREC(GMRCDA) ;attempt to lock a consult record using order or record
  1.  ; Input:
  1.  ;   GMRCDA  = ien of consult record from file 123
  1.  ;
  1.  ; Output:
  1.  ;     1 or 0^reason can't be locked
  1.  ;          1 = successfully locked
  1.  ;          0 = couldn't be locked
  1.  N GMRCORD,GMRCMSG
  1.  S GMRCORD=$P($G(^GMR(123,GMRCDA,0)),U,3)
  1.  I $G(GMRCORD) D  ;an order associated
  1.  . S GMRCMSG=$$LOCK1^ORX2(GMRCORD)
  1.  . ; GMRCMSG=1 if locked  or 0 if couldn't be locked
  1.  I $L($G(GMRCMSG)) Q GMRCMSG
  1.  ; no order = Inter-facility Consult so lock consult record
  1.  L +^GMR(123,GMRCDA):5
  1.  I '$T Q "0^Another user is editing this record" ; couldn't lock it
  1.  Q 1
  1.  ;
  1. UNLKREC(GMRCDA) ;unlock a consult record
  1.  ; Input:
  1.  ;   GMRCDA  = ien of consult record from file 123
  1.  ;
  1.  N GMRCORD
  1.  S GMRCORD=$P($G(^GMR(123,GMRCDA,0)),U,3)
  1.  I $G(GMRCORD) D  Q
  1.  . D UNLK1^ORX2(GMRCORD)
  1.  L -^GMR(123,GMRCDA)
  1.  Q