Routine: DG10

DG10 ;ALB/MRL,DAK,AEG,PHH,TMK-LOAD/EDIT PATIENT DATA ; 08/26/08

 ;;5.3;Registration;**32,109,139,149,182,326,513,425,574,642,658,1015,1016**;Aug 13, 1993;Build 20

START ;

 D LO^DGUTL

 I $G(DGPRFLG)=1,$G(DGPLOC)=1 D  G Q:$G(DGRPOUT),A1

 .; D EN^DGRPD,REG^IVMCQ($G(DFN))

 . D EN^DGRPD

 . Q:$G(DGRPOUT)

 . D REG^IVMCQ($G(DFN))

 . D HINQ

A W !! K VET,DIE,DIC,CARD S DIC=2,DLAYGO=2,DIC(0)="ALEQM" K DIC("S") D ^DIC G Q:Y<0 S (DFN,DA)=+Y,DGNEW=$P(Y,"^",3) K DLAYGO

 N Y D PAUSE I DGNEW D NEW^DGRP S DA=DFN,VET=$S($D(^DPT(DFN,"VET")):^("VET")'="Y",1:0)

 ;MPI QUERY

 ;check to see if CIRN PD/MPI is installed

 N X S X="MPIFAPI" X ^%ZOSF("TEST") G:'$T SKIP

 K MPIFRTN

 D MPIQ^MPIFAPI(DFN)

 K MPIFRTN

 N DGNOIVMUPD

 S DGNOIVMUPD=1 ; Set flag to prevent MT Event Driver from updating converted IVM test

 I +$G(DGNEW) D

 . ; query CMOR for Patient Record Flag Assignments if NEW patient and

 . ; display results

 . I $$PRFQRY^DGPFAPI(DFN) D DISPPRF^DGPFAPI(DFN)

SKIP ;

 S DGELVER=0 D EN^DGRPD I $D(DGRPOUT) K DGRPOUT G A

 D HINQ,REG^IVMCQ($G(DFN)) G A1

HINQ ;

 S Y=$S($D(^DG(43,1,0)):^(0),1:0) I $P(Y,U,27) S X="DVBHQZ4" X ^%ZOSF("TEST") I $T D

 .N DGROUT

 .S DGROUT=X

 .I $G(DFN) D

 ..N X,Y,DGRP

 ..F X=.3,.32 S DGRP(X)=$G(^DPT(DFN,X))

 ..W !,"     Money Verified: " S Y=$P(DGRP(.3),"^",6) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NOT VERIFIED")

 ..W ?40,"   Service Verified: " S Y=$P(DGRP(.32),"^",2) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NOT VERIFIED")

 .D @("EN^"_DGROUT) K Y Q  ;from dgdem0

 ;   SDIEMM is used as a flag by AMBCARE Incomplete Encounter Management

 ;   to bypass the embossing routines when calling load/edit from IEMM

A1 D  G H:'%,CK:%'=1 S DGRPV=0 D EN1^DGRP,MT(DFN),CP G Q:$G(DGPRFLG)=1 G Q:$G(SDIEMM) G Q:'$D(DA),EMBOS

 .W !,"Do you want to ",$S(DGNEW:"enter",1:"edit")," Patient Data"

 .S %=1 D YN^DICN

 .I +$G(DGNEW) Q

 .I $$ADD^DGADDUTL($G(DFN)) ;

H W !?5,"Enter 'YES' to enter/edit registration data or 'NO' to continue without",!?5,"editing."

 G A1

CK S DGEDCN=1 D ^DGRPC,MT(DFN),CP

 G Q:$G(DGPRFLG)=1 G Q:$G(SDIEMM)

 I $G(DGER)[55 K DIR S DIR(0)="Y",DIR("A")="Do you wish to return to Screen #9 to enter missing Income Data? " D ^DIR K DIR

 ;G:Y ^DGRP9

EMBOS ;W ! D EMBOS^DGQEMA G A

G A

Q K X,Y,Z,DIC,DGELVER,DGNEW,DGRPV,VET Q

MT(DFN) ; Check if user requires a means test.  Ask user if they want to proceedif

 ; one is required

 I '$D(SDIEMM) DO

 .N DGREQF,DIV

 .D EN^DGMTR

 .I DGREQF D EDT^DGMTU(DFN,DT):$P($$MTS^DGMTU(DFN),U,2)="R"

.Q

 I $D(SDIEMM) DO

 .N DGMTI

 .S DGMTI=$$LST^DGMTU(DFN,SCINF("ENCOUNTER"),1)

 .I $P(DGMTI,U,4)="R" D  I 1

 ..S DGMT0=$G(^DGMT(408.31,+DGMTI,0)),DGMTDT=$P(DGMT0,"^")

 ..I '$$OKTOCONT(DGMTDT) Q

 ..S DGMTI=+DGMTI,DGMTYPT=1,DGMTACT="COM",DGMTROU="COM^DGMTEO" D EN^DGMTSC

 .E  D WARNING

.Q

WARNING ;

 ;prints a warning to the screen about means test

 W !!,"A means test for this encounter date was not found and may be required!"

 W !,"Further investigation will be needed."

W !

 D PAUSE

PAUSE ;

 N DIR

 S DIR(0)="FAO",DIR("A")="Press ENTER to continue " D ^DIR

OKTOCONT(Y) ;

 N DIR

 W !!,"Patient Requires a means Test"

 X ^DD("DD")

 W !,"Primary Means Test Required from '",Y,"'",!

 I $D(SDIEMM),'$D(^XUSEC("SCENI MEANS TEST EDIT",DUZ)) DO  G OKQ

 .W !,$C(7),"You do not have the appropriate IEMM Security Key.  Contact your supervisor.",!

 .D PAUSE

 .S Y=0

 S DIR("A")="Do you wish to proceed with the means test at this time"

 S DIR("B")="YES"

 S DIR(0)="Y"

 D ^DIR

OKQ Q $S(Y=1:1,1:0)

CP ;If not (autoexempt or MTested) & no CP test this year then

 ;prompt for add/edit cp test

 N DIV,DGIB,DGIBDT,DGX,X,DIRUT,DTOUT

 G:'$P($G(^DG(43,1,0)),U,41) QTCP ;USE CP FLAG

 S DGIBDT=$S($D(DFN1):9999999-DFN1,1:DT)

 D EN^DGMTCOR

 I +$G(DGNOCOPF) S DGMTCOR=0

 I DGMTCOR D THRESH^DGMTCOU1(DGIBDT) D EDT^DGMTCOU(DFN,DT)

 K DGNOCOPF

QTCP Q

DG10      ;ALB/MRL,DAK,AEG,PHH,TMK-LOAD/EDIT PATIENT DATA ; 08/26/08

 +1       ;;5.3;Registration;**32,109,139,149,182,326,513,425,574,642,658,1015,1016**;Aug 13, 1993;Build 20

START     ;

 +1        DO LO^DGUTL

 +2        IF $GET(DGPRFLG)=1

               IF $GET(DGPLOC)=1

                   Begin DoDot:1

 +3       ; D EN^DGRPD,REG^IVMCQ($G(DFN))

 +4                    DO EN^DGRPD

 +5                    IF $GET(DGRPOUT)

                           QUIT

 +6                    DO REG^IVMCQ($GET(DFN))

 +7                    DO HINQ

                   End DoDot:1

                   IF $GET(DGRPOUT)

                       GOTO Q

                   GOTO A1

 +8       ;

A          WRITE !!

           KILL VET,DIE,DIC,CARD

           SET DIC=2

           SET DLAYGO=2

           SET DIC(0)="ALEQM"

           KILL DIC("S")

           DO ^DIC

           IF Y<0

               GOTO Q

           SET (DFN,DA)=+Y

           SET DGNEW=$PIECE(Y,"^",3)

           KILL DLAYGO

 +1        NEW Y

           DO PAUSE

           IF DGNEW

               DO NEW^DGRP

               SET DA=DFN

               SET VET=$SELECT($DATA(^DPT(DFN,"VET")):^("VET")'="Y",1:0)

 +2       ;

 +3       ;MPI QUERY

 +4       ;check to see if CIRN PD/MPI is installed

 +5        NEW X

           SET X="MPIFAPI"

           XECUTE ^%ZOSF("TEST")

           IF '$TEST

               GOTO SKIP

 +6        KILL MPIFRTN

 +7        DO MPIQ^MPIFAPI(DFN)

 +8        KILL MPIFRTN

 +9       ;

 +10       NEW DGNOIVMUPD

 +11      ; Set flag to prevent MT Event Driver from updating converted IVM test

           SET DGNOIVMUPD=1

 +12       IF +$GET(DGNEW)

               Begin DoDot:1

 +13      ; query CMOR for Patient Record Flag Assignments if NEW patient and

 +14      ; display results

 +15               IF $$PRFQRY^DGPFAPI(DFN)

                       DO DISPPRF^DGPFAPI(DFN)

               End DoDot:1

 +16      ;

SKIP      ;

 +1        SET DGELVER=0

           DO EN^DGRPD

           IF $DATA(DGRPOUT)

               KILL DGRPOUT

               GOTO A

 +2        DO HINQ

           DO REG^IVMCQ($GET(DFN))

           GOTO A1

 +3       ;

HINQ      ;

 +1        SET Y=$SELECT($DATA(^DG(43,1,0)):^(0),1:0)

           IF $PIECE(Y,U,27)

               SET X="DVBHQZ4"

               XECUTE ^%ZOSF("TEST")

               IF $TEST

                   Begin DoDot:1

 +2                    NEW DGROUT

 +3                    SET DGROUT=X

 +4                    IF $GET(DFN)

                           Begin DoDot:2

 +5                            NEW X,Y,DGRP

 +6                            FOR X=.3,.32

                                   SET DGRP(X)=$GET(^DPT(DFN,X))

 +7                            WRITE !,"     Money Verified: "

                               SET Y=$PIECE(DGRP(.3),"^",6)

                               IF Y]""

                                   XECUTE ^DD("DD")

                               WRITE $SELECT(Y]"":Y,1:"NOT VERIFIED")

 +8                            WRITE ?40,"   Service Verified: "

                               SET Y=$PIECE(DGRP(.32),"^",2)

                               IF Y]""

                                   XECUTE ^DD("DD")

                               WRITE $SELECT(Y]"":Y,1:"NOT VERIFIED")

                           End DoDot:2

 +9       ;from dgdem0

                       DO @("EN^"_DGROUT)

                       KILL Y

                       QUIT

                   End DoDot:1

 +10       QUIT

 +11      ;

 +12      ;   SDIEMM is used as a flag by AMBCARE Incomplete Encounter Management

 +13      ;   to bypass the embossing routines when calling load/edit from IEMM

 +14      ;

A1         Begin DoDot:1

 +1            WRITE !,"Do you want to ",$SELECT(DGNEW:"enter",1:"edit")," Patient Data"

 +2            SET %=1

               DO YN^DICN

 +3            IF +$GET(DGNEW)

                   QUIT

 +4       ;

               IF $$ADD^DGADDUTL($GET(DFN))

           End DoDot:1

           IF '%

               GOTO H

           IF %'=1

               GOTO CK

           SET DGRPV=0

           DO EN1^DGRP

           DO MT(DFN)

           DO CP

           IF $GET(DGPRFLG)=1

               GOTO Q

           IF $GET(SDIEMM)

               GOTO Q

           IF '$DATA(DA)

               GOTO Q

           GOTO EMBOS

 +5       ;

H          WRITE !?5,"Enter 'YES' to enter/edit registration data or 'NO' to continue without",!?5,"editing."

 +1        GOTO A1

 +2       ;

CK         SET DGEDCN=1

           DO ^DGRPC

           DO MT(DFN)

           DO CP

 +1        IF $GET(DGPRFLG)=1

               GOTO Q

           IF $GET(SDIEMM)

               GOTO Q

 +2        IF $GET(DGER)[55

               KILL DIR

               SET DIR(0)="Y"

               SET DIR("A")="Do you wish to return to Screen #9 to enter missing Income Data? "

               DO ^DIR

               KILL DIR

 +3       ;G:Y ^DGRP9

 +4       ;

EMBOS     ;W ! D EMBOS^DGQEMA G A

 +1        GOTO A

 +2       ;

 +3       ;

Q          KILL X,Y,Z,DIC,DGELVER,DGNEW,DGRPV,VET

           QUIT

 +1       ;

MT(DFN)   ; Check if user requires a means test.  Ask user if they want to proceedif

 +1       ; one is required

 +2        IF '$DATA(SDIEMM)

               Begin DoDot:1

 +3                NEW DGREQF,DIV

 +4                DO EN^DGMTR

 +5                IF DGREQF

                       IF $PIECE($$MTS^DGMTU(DFN),U,2)="R"

                           DO EDT^DGMTU(DFN,DT)

 +6                QUIT

               End DoDot:1

 +7        IF $DATA(SDIEMM)

               Begin DoDot:1

 +8                NEW DGMTI

 +9                SET DGMTI=$$LST^DGMTU(DFN,SCINF("ENCOUNTER"),1)

 +10               IF $PIECE(DGMTI,U,4)="R"

                       Begin DoDot:2

 +11                       SET DGMT0=$GET(^DGMT(408.31,+DGMTI,0))

                           SET DGMTDT=$PIECE(DGMT0,"^")

 +12                       IF '$$OKTOCONT(DGMTDT)

                               QUIT

 +13                       SET DGMTI=+DGMTI

                           SET DGMTYPT=1

                           SET DGMTACT="COM"

                           SET DGMTROU="COM^DGMTEO"

                           DO EN^DGMTSC

                       End DoDot:2

                       IF 1

 +14              IF '$TEST

                       DO WARNING

 +15               QUIT

               End DoDot:1

 +16       QUIT

 +17      ;

WARNING   ;

 +1       ;prints a warning to the screen about means test

 +2       ;

 +3        WRITE !!,"A means test for this encounter date was not found and may be required!"

 +4        WRITE !,"Further investigation will be needed."

 +5        WRITE !

 +6        DO PAUSE

 +7        QUIT

 +8       ;

PAUSE     ;

 +1        NEW DIR

 +2        SET DIR(0)="FAO"

           SET DIR("A")="Press ENTER to continue "

           DO ^DIR

 +3        QUIT

 +4       ;

OKTOCONT(Y) ;

 +1       ;

 +2        NEW DIR

 +3        WRITE !!,"Patient Requires a means Test"

 +4        XECUTE ^DD("DD")

 +5        WRITE !,"Primary Means Test Required from '",Y,"'",!

 +6       ;

 +7        IF $DATA(SDIEMM)

               IF '$DATA(^XUSEC("SCENI MEANS TEST EDIT",DUZ))

                   Begin DoDot:1

 +8                    WRITE !,$CHAR(7),"You do not have the appropriate IEMM Security Key.  Contact your supervisor.",!

 +9                    DO PAUSE

 +10                   SET Y=0

                   End DoDot:1

                   GOTO OKQ

 +11      ;

 +12       SET DIR("A")="Do you wish to proceed with the means test at this time"

 +13       SET DIR("B")="YES"

 +14       SET DIR(0)="Y"

 +15       DO ^DIR

OKQ        QUIT $SELECT(Y=1:1,1:0)

 +1       ;

CP        ;If not (autoexempt or MTested) & no CP test this year then

 +1       ;prompt for add/edit cp test

 +2        NEW DIV,DGIB,DGIBDT,DGX,X,DIRUT,DTOUT

 +3       ;USE CP FLAG

           IF '$PIECE($GET(^DG(43,1,0)),U,41)

               GOTO QTCP

 +4        SET DGIBDT=$SELECT($DATA(DFN1):9999999-DFN1,1:DT)

 +5        DO EN^DGMTCOR

 +6        IF +$GET(DGNOCOPF)

               SET DGMTCOR=0

 +7        IF DGMTCOR

               DO THRESH^DGMTCOU1(DGIBDT)

               DO EDT^DGMTCOU(DFN,DT)

 +8        KILL DGNOCOPF

QTCP       QUIT

DG10.m