DGMTCOU.m

DGMTCOU ;ALB/CAW - Copay Utilities ; 12/10/92

 ;;5.3;Registration;**45,182,1015**;Aug 13, 1993;Build 21

 ;

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=""

 ;ihs/cmi/maw 02/08/2012 patch 1014 no IB next line

 ;G:$P($$RXST^IBARXEU(DFN,DT),U,3)=2010&('$$YR(DFN,DT,DGMTI)) EDTQ D DISP^IBARXEU(DFN,DGDT,2) W !

 ;

 ;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

DGMTCOU   ;ALB/CAW - Copay Utilities ; 12/10/92

 +1       ;;5.3;Registration;**45,182,1015**;Aug 13, 1993;Build 21

 +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      ;ihs/cmi/maw 02/08/2012 patch 1014 no IB next line

 +18      ;G:$P($$RXST^IBARXEU(DFN,DT),U,3)=2010&('$$YR(DFN,DT,DGMTI)) EDTQ D DISP^IBARXEU(DFN,DGDT,2) W !

 +19      ;

 +20      ;If test is uneditable, print error message and allow user to view test

 +21       SET SOURCE=$PIECE($GET(^DGMT(408.31,DGMTI,0)),U,23)

 +22       IF SOURCE

               IF '$PIECE($GET(^DG(408.34,SOURCE,0)),U,2)

                   Begin DoDot:1

 +23                   WRITE !,"The source of this test makes the test uneditable."

 +24                   SET DIR("A")="Would you like to view the copay test"

                       SET DIR("B")="NO"

                       SET DIR(0)="Y"

 +25                   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

 +26      ;

 +27       SET DIR("A")="Do you wish to "_$SELECT(DGMTS="":"add a",1:"edit the")_" copay test at this time"

 +28       SET DIR("B")=$SELECT(DGMTS=10:"YES",1:"NO")

           SET DIR(0)="Y"

 +29       WRITE !

           DO ^DIR

           IF $DATA(DTOUT)!($DATA(DUOUT))

               GOTO EDTQ

 +30       IF Y

               IF DGMTS]""

                   SET DGMTYPT=2

                   SET DGMTACT="EDT"

                   SET DGMTROU="EDTQ^DGMTCOU"

                   GOTO EN^DGMTSC

 +31       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