DGMTUTL ;ALB/CAW/BRM/LBD - Means Test generic utilities ; 8/12/02 4:33pm
;;5.3;Registration;**3,31,166,182,454**;Aug 13, 1993
;
FDATE(Y) ; -- return formatted date
; input: Y := field name
; output: [returned] := formatted date only
N DGY
S DGY=$$FMTE^XLFDT(Y,"5F"),DGY=$TR(DGY," ","0")
Q DGY
;
FTIME(Y) ; -- return formatted date/time
; input: Y := internal date/time
; output: [returned] := formatted date and time
D DD^%DT
Q Y
;
RANGE(WHEN) ; select date range
; input: WHEN := past or future dates (optional)
; output: DGBEG := begin date
; DGEND := end date
; return: was selection made [ 1|yes 0|no]
W !!,$$LINE("Date Range Selection")
DATE S DIR(0)="D^::EX",DIR("A")="Enter Beginning Date",DIR("?")="^D HELP^%DTC" D ^DIR K DIR G:$D(DIRUT) RANGEQ S DGBEG=Y
I $G(WHEN)="P",DGBEG>(DT_.9999) W !," Future dates are not allowed.",*7 K DGBEG G DATE
I $G(WHEN)="F",(DGBEG_.9999)
(DT_.9999) W !," Future dates are not allowed.",*7 K DGEND G DATE
I $G(WHEN)="F",(DGEND_.9999)0
;
CLINIC() ; -- get clinic data
; input: VAUTD := divisions selected
; output: VAUTC := clinic selected (VAUTC=1 for all)
; return: was selection made [ 1|yes 0|no]
;
W !!,$$LINE("Clinic Selection")
S DIC("S")="I $S(VAUTD:1,$D(VAUTD(+$P(^SC(Y,0),U,15))):1,'+$P(^(0),U,15)&$D(VAUTD(+$O(^DG(40.8,0)))):1,1:0)"
S DIC="^SC(",VAUTSTR="clinic",VAUTVB="VAUTC",VAUTNI=2
D FIRST^VAUTOMA
I Y<0 K VAUTC
CLINICQ Q $D(VAUTC)>0
;
;
LINE(STR) ; -- print line
; input: STR := text to insert
; output: none
; return: text to use
;
N X
S:STR]"" STR=" "_STR_" "
S $P(X,"_",(IOM/2)-($L(STR)/2))=""
Q X_STR_X
;
ASK2 S (VAUTD,Y)=0 I '$D(^DG(40.8,+$O(^DG(40.8,0)),0)) W !,*7,"***WARNING...MEDICAL CENTER DIVISION FILE IS NOT SET UP" G ASK2Q
I '$P($G(^DG(43,1,"GL")),U,2) S VAUTD=1 G ASK2Q
I $D(^DG(43,1,"GL")),$P(^("GL"),U,2) G DIVISION^VAUTOMA
S I=$O(^DG(40.8,0)) G:'$D(^DG(40.8,+I,0)) ASK2Q S VAUTD(I)=$P(^(0),U) K DIC Q
ASK2Q ;
Q
;
CLOSE ; Utility to clean up tasked outputs
Q:'$D(ZTQUEUED)
D KILL^%ZTLOAD K ZTSK,ZTDESC,ZTRTN,ZTREQ,ZTSAVE,ZTIO,ZTDTH,ZTUCI,IO("Q"),IO("C")
Q
;
XMY(GROUP,DGDUZ,DGPOST) ; -- set up XMY for mail group members
; input: GROUP := mail group efn [required]
; DGDUZ := send to current user [ 0|no ; 1|yes] [optional]
; DGPOST := send to postmaster if XMY is undefined
; [ 0|no ; 1|yes] [optional]
; output: XMY := array of users
; XMDUZ := message sender set postmaster
;
N I K XMY
I '$D(DGDUZ) N DGDUZ S DGDUZ=1
I '$D(DGPOST) N DGPOST S SDPOST=1
S XMY("G."_$P($G(^XMB(3.8,GROUP,0)),U))=""
I DGDUZ,DUZ S XMY(DUZ)=""
; makes sure it gets sent to someone
I '$D(XMY),DGPOST S XMY(.5)=""
; make postmaster the sender so it will show up as new to DUZ
S XMDUZ=.5
Q
;
;
LOCK(DFN) ;
; Description: Sets a lock used to synchronize local income test
; options with the income test upload.
;
; Input:
; DFN - ien of record in PATIENT file
;
; Output:
; Function value - returns 1 if the lock was obtained, 0 otherwise.
;
Q:'$G(DFN) 1
L +^DGMT("LOCAL INCOME TEST",DFN):5
Q $T
;
;
UNLOCK(DFN) ;
; Description: Release the lock obtained by calling $$LOCK(DFN).
;
; Input:
; DFN - ien of record in PATIENT file
;
; Output: none
;
Q:'$G(DFN)
L -^DGMT("LOCAL INCOME TEST",DFN)
Q
;
PA(DGMTI) ;Determine if the Pending Adjudication is for MT or GMT
; Input:
; DGMTI - IEN of Annual Means Test file #408.31
; Output:
; Returns "MT","GMT", or "" if it can't be determined
;
N PA,DGMT0,MTTHR,GMTTHR
S PA=""
I '$G(DGMTI) Q PA
S DGMT0=$G(^DGMT(408.31,DGMTI,0))
; If means test status is not Pending Adjudication, quit
I $P(DGMT0,U,3)'=2 Q PA
; Get MT Threshold and GMT Threshold
S MTTHR=+$P(DGMT0,U,12) I 'MTTHR Q PA
S GMTTHR=+$P(DGMT0,U,27)
; If GMT Threshold is greater than MT Threshold then return GMT,
; otherwise return MT
S PA=$S(GMTTHR>MTTHR:"GMT",1:"MT")
Q PA