DGMTCOU ;ALB/CAW/HM - Copay Utilities ; 12/10/92
;;5.3;Registration;**45,182,972**;Aug 13, 1993;Build 80
;
EDT(DFN,DGDT) ;Display patients current copay test information and provide
; the user with the option of proceeding with adding a
; copay test or editing an existing copay test
; Input -- DFN Patient IEN
; DGDT Date/Time
; Output -- None
;
;
N DGMTERR,SOURCE,DGMTYPT
S DGMTYPT=2
;
; obtain lock used to synchronize local MT/CT options with income test upload
I $$LOCK^DGMTUTL(DFN)
;
S DGMTI=+$$LST^DGMTU(DFN,DGDT,2)
S DGMT0=$G(^DGMT(408.31,DGMTI,0)),DGMTDT=+DGMT0 S DGMTS=$P(DGMT0,"^",3)
I $$YR(DFN,DGDT,+DGMT0) S DGMTS=""
G:$P($$RXST^IBARXEU(DFN,DT),U,3)=2010&('$$YR(DFN,DT,DGMTI)) EDTQ I $P($G(^DPT(DFN,.54)),"^")="Y" D DISP^IBARXEU(DFN,DGDT,2) W ! ;DG*5.3*972 HM if MOH="Y" do not display
;
;If test is uneditable, print error message and allow user to view test
S SOURCE=$P($G(^DGMT(408.31,DGMTI,0)),U,23)
I SOURCE,'$P($G(^DG(408.34,SOURCE,0)),U,2) D D:$G(DGMTERR) DISPLAY^DGMTU23(DGMTI,2),PAUSE^DGMTE G EDTQ
.W !,"The source of this test makes the test uneditable."
.S DIR("A")="Would you like to view the copay test",DIR("B")="NO",DIR(0)="Y"
.D ^DIR K DIR S DGMTERR=Y I $D(DTOUT)!($D(DUOUT)) K DGMTERR,DTOUT,DUOUT
;
S DIR("A")="Do you wish to "_$S(DGMTS="":"add a",1:"edit the")_" copay test at this time"
S DIR("B")=$S(DGMTS=10:"YES",1:"NO"),DIR(0)="Y"
W ! D ^DIR G EDTQ:$D(DTOUT)!($D(DUOUT))
I Y,DGMTS]"" S DGMTYPT=2,DGMTACT="EDT",DGMTROU="EDTQ^DGMTCOU" G EN^DGMTSC
I Y,DGMTS="" S DGMTYPT=2,DGMTACT="ADD",DGMTROU="EDTQ^DGMTCOU" S DGMTDT=DT D ADD^DGMTA G EN^DGMTSC
EDTQ K DGMT0,DGMTACT,DGMTDT,DGMTI,DGMTROU,DGMTS,DIR,Y
;
; release lock used to synchronize local MT/CT options with income test upload
D UNLOCK^DGMTUTL(DFN)
Q
;
YR(DFN,DGDT,DGMT0) ;Check to see if test is greater than 365 days
; Input -- DFN Patient IEN
; DGDT Date/Time to check against
; DGMT0 Zeroth node of Copay test
; Output -- 1 = TEST IS 365 OR MORE DAYS OLD
; 0 = TEST IS LESS THAN 365 DAYS OLD
;
N X,X1,X2,DGLDYR,DGY S DGY=1
S DGLDYR=$E(DGMT0,1,3)_"1231"
I DGMTI S X1=DGDT,X2=$P(DGMT0,U,2) D ^%DTC I X<365,DGDT'>DGLDYR S DGY=0
Q DGY
;
ON ; Check to see of copay software is on
; Input - none
; Output - 1 = YES
; 0 = NO
I $P(^DG(43,1,0),U,41) S Y=1 Q
S Y=0
Q
ASKNW() ;
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTCOU 2524 printed Dec 13, 2024@02:44:41 Page 2
DGMTCOU ;ALB/CAW/HM - Copay Utilities ; 12/10/92
+1 ;;5.3;Registration;**45,182,972**;Aug 13, 1993;Build 80
+2 ;
EDT(DFN,DGDT) ;Display patients current copay test information and provide
+1 ; the user with the option of proceeding with adding a
+2 ; copay test or editing an existing copay test
+3 ; Input -- DFN Patient IEN
+4 ; DGDT Date/Time
+5 ; Output -- None
+6 ;
+7 ;
+8 NEW DGMTERR,SOURCE,DGMTYPT
+9 SET DGMTYPT=2
+10 ;
+11 ; obtain lock used to synchronize local MT/CT options with income test upload
+12 IF $$LOCK^DGMTUTL(DFN)
+13 ;
+14 SET DGMTI=+$$LST^DGMTU(DFN,DGDT,2)
+15 SET DGMT0=$GET(^DGMT(408.31,DGMTI,0))
SET DGMTDT=+DGMT0
SET DGMTS=$PIECE(DGMT0,"^",3)
+16 IF $$YR(DFN,DGDT,+DGMT0)
SET DGMTS=""
+17 ;DG*5.3*972 HM if MOH="Y" do not display
if $PIECE($$RXST^IBARXEU(DFN,DT),U,3)=2010&('$$YR(DFN,DT,DGMTI))
GOTO EDTQ
IF $PIECE($GET(^DPT(DFN,.54)),"^")="Y"
DO DISP^IBARXEU(DFN,DGDT,2)
WRITE !
+18 ;
+19 ;If test is uneditable, print error message and allow user to view test
+20 SET SOURCE=$PIECE($GET(^DGMT(408.31,DGMTI,0)),U,23)
+21 IF SOURCE
IF '$PIECE($GET(^DG(408.34,SOURCE,0)),U,2)
Begin DoDot:1
+22 WRITE !,"The source of this test makes the test uneditable."
+23 SET DIR("A")="Would you like to view the copay test"
SET DIR("B")="NO"
SET DIR(0)="Y"
+24 DO ^DIR
KILL DIR
SET DGMTERR=Y
IF $DATA(DTOUT)!($DATA(DUOUT))
KILL DGMTERR,DTOUT,DUOUT
End DoDot:1
if $GET(DGMTERR)
DO DISPLAY^DGMTU23(DGMTI,2)
DO PAUSE^DGMTE
GOTO EDTQ
+25 ;
+26 SET DIR("A")="Do you wish to "_$SELECT(DGMTS="":"add a",1:"edit the")_" copay test at this time"
+27 SET DIR("B")=$SELECT(DGMTS=10:"YES",1:"NO")
SET DIR(0)="Y"
+28 WRITE !
DO ^DIR
if $DATA(DTOUT)!($DATA(DUOUT))
GOTO EDTQ
+29 IF Y
IF DGMTS]""
SET DGMTYPT=2
SET DGMTACT="EDT"
SET DGMTROU="EDTQ^DGMTCOU"
GOTO EN^DGMTSC
+30 IF Y
IF DGMTS=""
SET DGMTYPT=2
SET DGMTACT="ADD"
SET DGMTROU="EDTQ^DGMTCOU"
SET DGMTDT=DT
DO ADD^DGMTA
GOTO EN^DGMTSC
EDTQ KILL DGMT0,DGMTACT,DGMTDT,DGMTI,DGMTROU,DGMTS,DIR,Y
+1 ;
+2 ; release lock used to synchronize local MT/CT options with income test upload
+3 DO UNLOCK^DGMTUTL(DFN)
+4 QUIT
+5 ;
YR(DFN,DGDT,DGMT0) ;Check to see if test is greater than 365 days
+1 ; Input -- DFN Patient IEN
+2 ; DGDT Date/Time to check against
+3 ; DGMT0 Zeroth node of Copay test
+4 ; Output -- 1 = TEST IS 365 OR MORE DAYS OLD
+5 ; 0 = TEST IS LESS THAN 365 DAYS OLD
+6 ;
+7 NEW X,X1,X2,DGLDYR,DGY
SET DGY=1
+8 SET DGLDYR=$EXTRACT(DGMT0,1,3)_"1231"
+9 IF DGMTI
SET X1=DGDT
SET X2=$PIECE(DGMT0,U,2)
DO ^%DTC
IF X<365
IF DGDT'>DGLDYR
SET DGY=0
+10 QUIT DGY
+11 ;
ON ; Check to see of copay software is on
+1 ; Input - none
+2 ; Output - 1 = YES
+3 ; 0 = NO
+4 IF $PIECE(^DG(43,1,0),U,41)
SET Y=1
QUIT
+5 SET Y=0
+6 QUIT
ASKNW() ;
+1 QUIT 0
