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