DGMTA ;ALB/RMO/CAW/LD/SCG/AEG/PHH/HM - Add a New Means Test;2/24/10 2:58pm
 ;;5.3;Registration;**33,45,137,166,177,182,290,344,332,433,458,535,612,564,688,661,840,972,996,993**;Aug 13, 1993;Build 92
 ;
EN ;Entry point to add a new means test
 N DGMDOD S DGMDOD=""
 S DGADDF=1
 I $D(DGMTDFN)#2 D UNLOCK^DGMTUTL(DGMTDFN) K DGMTDFN
 S DIC="^DPT(",DIC(0)="AEMQ" W ! D ^DIC K DIC G Q:Y<0 S (DFN,DGMTDFN)=+Y
 I $P($G(^DPT(DFN,.35)),U)'="" S DGMDOD=$P(^DPT(DFN,.35),U)
 I $G(DGMDOD) W !,"Patient died on: ",$$FMTE^XLFDT(DGMDOD,"1D") Q
 ;
 ; check if income test in progress
 D CKUPLOAD^IVMCUPL(DFN)
 ;
 ; obtain lock used to synchronize local MT/CT options with income test upload
 I $$LOCK^DGMTUTL(DFN)
 ;
 I DGMTYPT=1 N DGDOM1 D EN^DGMTR I 'DGREQF,'$G(DGDOM1) W !,*7,"A means test can only be added for patients who require one.",! K DGDOM1 G EN
 ;
 N FUTMT S FUTMT=$$FUT^DGMTU(DFN,"",DGMTYPT) I FUTMT D FTST G EN
 ;
 ;if a test was auto-completed, DGADDF gets set to 0
 I 'DGADDF W !!,*7,"A means test already exists and is in effect" G EN
 ;
 K:DGMTYPT=1 DGDOM1
 I DGMTYPT=2 D EN^DGMTCOR I 'DGMTCOR S I=$P($T(WHY+DGWRT),";",3,99) W !!,*7,"A copay exemption test can only be added for applicable veterans.",!,I G EN
 S DGLDT=$$LST^DGMTU(DFN,"",DGMTYPT),DGLD=$P(DGLDT,U,2),DGLDYR=$E(DGLD,1,3)_"1231"
 ;
DT S %DT("A")="DATE OF TEST: ",%DT="AEX",%DT(0)="-NOW",%DT("B")="NOW" W ! D ^%DT K %DT G Q:Y<0 S DGMTDT=Y
 I DGMTDT<$S(DGMTYPT=1:2860701,1:2921029) W !?3,*7,"The date of test cannot be before "_$S(DGMTYPT=1:"7/1/1986.",1:"10/29/1992.") G DT
 I DGLD,DGMTDT<DGLD W !?3,*7,"The date of test cannot be before the last date of test on " S Y=DGLD X ^DD("DD") W Y,"." G DT
 I DGLD S X1=DGMTDT,X2=DGLD D ^%DTC I X<365,DGMTDT'>DGLDYR D  G EN
 .W !?3,*7,"An annual date of test already exists on " S Y=DGLD X ^DD("DD") W Y,"."
 .S DGTTYP=$S(DGMTYPT=1:"Means ",1:"Copay Exemption ")
 .W !,$S($P($G(^DG(408.34,+$P($G(^DGMT(408.31,+DGLDT,0)),U,23),0)),U)="VAMC":"   Use the 'Edit an Existing "_DGTTYP_"Test' Option.",1:"   Use the 'View a Past Means Test' Option.")
 ;
 ;Means Test cannot be added for patient on a DOM ward on date of test
 I DGMTYPT=2 G PRINT
 N VAINDT,VADMVT,DGDOM,DGDOM1
 S VAINDT=DGMTDT
 D DOM1^DGMTR I $G(DGDOM1) D  K VAINDT,VADMVT,DGDOM,DGDOM1 G EN
 .W !,*7,"A Means Test cannot be added for patients on a DOM ward on date of test.",!
 K VAINDT,VADMVT,DGDOM,DGDOM1
 ;
 ;A warning message is displayed if last means test for patient is
 ;from a prior year and has a status of required.  The user is given
 ;the option to continue or stop adding a new means test.
 N %
 I DGLD,DGMTDT>DGLDYR,$P(DGLDT,"^",4)="R" D  Q:%=-1  I %=2 K % G EN
 .W !?3,*7,"WARNING - last means test on " S Y=DGLD X ^DD("DD") W Y," has a status of required."
DT2 .W !?3,"Do you still want to continue adding new test"
 .S %=2 D YN^DICN
 .I %=0 W !?3,"Answer 'Y'es to continue adding new test." G DT2
 .Q 
 K %
 ;
PRINT I "^P^A^C^G^"[(U_$P(DGLDT,U,4)_U) S %=1 W !,"Do you wish to print the prior means test" D YN^DICN G:%=-1 Q I %Y["?" W !!,"This will print the prior means test information.",! G PRINT
 I $G(%)=1 S DGX=DGMTDT,DGMTDT=DGLD,DGMTI=+DGLDT,DGOPT="" D DEV^DGMTP,CLOSE^DGUTQ S DGMTDT=DGX K DGX
 D ADD G EN:DGMTI<0
 S DGMTACT="ADD",DGMTROU="EN^DGMTA" G EN^DGMTSC
 ;
Q K DA,DFN,DGADDF,DGBL,DGFL,DGFLD,DGIRO,DGLD,DGLDT,DGLDYR,DGMTACT,DGMTCOR,DGMTDT,DGMTI,DGMTROU,DGREQF,DGTTYP,DGMTYPT,DGVI,DGVO,X,X1,X2,Y
 ;
 ; release lock used to synchronize local MT/CT options with income test upload
 I $D(DGMTDFN)#2 D UNLOCK^DGMTUTL(DGMTDFN) K DGMTDFN
 Q
 ;
ADD ;Add means test
 ; Input  -- DFN     Patient IEN
 ;           DGMTDT  Date
 ;           DGMTYPT Type of Test 1=MT 2=COPAY 4=LTC
 ; Output -- DGMTI   Annual Means/Copay/LTC Test IEN
 N DA,DD,DIC,DIK,DINUM,DLAYGO,DO,DS,X,D0,DGSITE,CONVRT,CURIEN,LINK,DGLNKMT
 ;
 ; obtain lock used to synchronize local MT/CT options with income test upload
 I $$LOCK^DGMTUTL(DFN) E  Q
 ;
 ; Check for Linked test and don't lose the link.
 S LINK="",DGLNKMT=$$LST^DGMTU(DFN,DGMTDT,DGMTYPT),CURIEN=+DGLNKMT
 I CURIEN D
 . ;Don't link test if it's in a different year (DG*5.3*661)
 . I $E($P(DGLNKMT,U,2),1,3)'=$E(DGMTDT,1,3) Q
 . S LINK=$P($G(^DGMT(408.31,CURIEN,2)),U,6)
 ;
 S DGSITE=$$GETSITE^DGMTU4(.DUZ)
 S X=DGMTDT,(DIC,DIK)="^DGMT(408.31,",DIC(0)="L",DLAYGO=408.31
 ;
 ;
 ;Look for existing IAI records and convert (if necessary)
 D ALL^DGMTU21(DFN,"VSD",DT,"IPR") ;ALL only returns IAI from last IY
 I $D(DGINC) DO
 . D ISCNVRT^DGMTUTL(.DGINC)
 ;
 ; The DIC("DR") string is built in this specific order so that
 ; all triggers and "M" x-refs fire correctly.  Should not be
 ; modified without an in-depth review of DD of file #408.31.
 ;
 I DGMTYPT=2 D
 .S DIC("DR")="2////"_(DGMTYPT'=4)_";2.05////"_DGSITE_";2.06////"_LINK
 .S DIC("DR")=DIC("DR")_";.02////"_DFN_";.019////"_DGMTYPT
 .S DIC("DR")=DIC("DR")_$S('$G(SRCTST):";.23////1",1:";.23////"_SRCTST) ;DG*5.3*996
 E  D
 .S DIC("DR")="2////"_(DGMTYPT'=4)_";2.05////"_DGSITE_";2.06////"_LINK
 .S DIC("DR")=DIC("DR")_";.019////"_DGMTYPT_";.02////"_DFN
 .S DIC("DR")=DIC("DR")_$S('$G(SRCTST):";.23////1",1:";.23////"_SRCTST) ;DG*5.3*996
 K DD,DO
 D FILE^DICN S DGMTI=+Y
 ;
 ; Check for another test in the current year and convert IAI records if needed
 ; Send new test date (as test that have) into VRCHKUP
 I $D(TYPE),((+TYPE=1)!(TYPE=4)) S CONVRT=$$VRCHKUP^DGMTU2(DGMTYPT,TYPE,DGMTDT)
 I $D(TYPE),((+TYPE'=1)&(TYPE'=4)) S CONVRT=$$VRCHKUP^DGMTU2(DGMTYPT,,DGMTDT)
 I '$D(TYPE) S CONVRT=$$VRCHKUP^DGMTU2(DGMTYPT,,DGMTDT)
 N DGERR,DGMTRT
 S DGMTRT(408.31,DGMTI_",",2.11)=1
 S DGERR=""
 D FILE^DIE("","DGMTRT",DGERR)
 ; release lock used to synchronize local MT/CT options with income test upload
 D UNLOCK^DGMTUTL(DFN)
 ;
ADDQ Q
 ;
FTST ; Build message for future tests that are added to the system, but
 ; were not performed by the VAMC trying to add a new MT.
 N SITE,DGMTYPT,DGTTYP,SRC,SCT
 S SCT=$P(^DGMT(408.31,+FUTMT,2),U,5),SITE=$$INST^DGENU()
 S DGMTYPT=$P(^DGMT(408.31,+FUTMT,0),U,19)
 S DGTTYP=$S(DGMTYPT=1:"Means ",1:"Copay Exemption ")
 W !?3,*7,"A future test already exists on "
 S Y=$P(FUTMT,U,2) X ^DD("DD") W Y,"."
 ; This site performed the MT
 I SITE=SCT D
 .W !?3,"Use the 'Edit an Existing "_DGTTYP_"Test' Option."
 ;
 ; The MT was added by another VAMC
 I SITE'=SCT D
 .S SRC=$P(FUTMT,U,5)
 .I SCT W !?3,"The "_DGTTYP_"Test was conducted at Site: ",SCT
 .W !?3,"Please contact "
 .W $S($D(^DIC(4,+SCT,0)):$P(^DIC(4,+SCT,0),U),SRC=2:"IVM",SRC=3:"the HEC",1:"the site")
 .W ",",!?3,"if it is necessary to edit the test."
 Q
 ; HM DG*5.3*972 - added Medal of Honor to list of reasons
 ; DSB DG*5.3*993- added Registration only
WHY ;Why Copay Test cannot be added
 ;;Patient is not a veteran.
 ;;Patient does not have a Primary Eligibility Code.
 ;;Patient is Service Connected 50-100%.
 ;;Means Test options must be used instead of Copay options.
 ;;Patient is receiving Aid and Attendance, automatically exempted.
 ;;Patient is receiving Housebound Benefits, automatically exempted.
 ;;Patient is receiving a VA Pension, automatically exempted.
 ;;Patient is in a DOM ward, automatically exempted.
 ;;Patient is an inpatient, automatically exempted.
 ;;Patient was a POW, automatically exempted.
 ;;Patient is Unemployable, automatically exempted.
 ;;Patient is Catastrophically Disabled, automatically exempted.
 ;;Patient is awarded Medal of Honor, automatically exempted.
 ;;Patient's Enrollment Status is REGISTRATION ONLY.
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTA   7581     printed  Sep 23, 2025@20:20:26                                                                                                                                                                                                       Page 2
DGMTA     ;ALB/RMO/CAW/LD/SCG/AEG/PHH/HM - Add a New Means Test;2/24/10 2:58pm
 +1       ;;5.3;Registration;**33,45,137,166,177,182,290,344,332,433,458,535,612,564,688,661,840,972,996,993**;Aug 13, 1993;Build 92
 +2       ;
EN        ;Entry point to add a new means test
 +1        NEW DGMDOD
           SET DGMDOD=""
 +2        SET DGADDF=1
 +3        IF $DATA(DGMTDFN)#2
               DO UNLOCK^DGMTUTL(DGMTDFN)
               KILL DGMTDFN
 +4        SET DIC="^DPT("
           SET DIC(0)="AEMQ"
           WRITE !
           DO ^DIC
           KILL DIC
           if Y<0
               GOTO Q
           SET (DFN,DGMTDFN)=+Y
 +5        IF $PIECE($GET(^DPT(DFN,.35)),U)'=""
               SET DGMDOD=$PIECE(^DPT(DFN,.35),U)
 +6        IF $GET(DGMDOD)
               WRITE !,"Patient died on: ",$$FMTE^XLFDT(DGMDOD,"1D")
               QUIT 
 +7       ;
 +8       ; check if income test in progress
 +9        DO CKUPLOAD^IVMCUPL(DFN)
 +10      ;
 +11      ; obtain lock used to synchronize local MT/CT options with income test upload
 +12       IF $$LOCK^DGMTUTL(DFN)
 +13      ;
 +14       IF DGMTYPT=1
               NEW DGDOM1
               DO EN^DGMTR
               IF 'DGREQF
                   IF '$GET(DGDOM1)
                       WRITE !,*7,"A means test can only be added for patients who require one.",!
                       KILL DGDOM1
                       GOTO EN
 +15      ;
 +16       NEW FUTMT
           SET FUTMT=$$FUT^DGMTU(DFN,"",DGMTYPT)
           IF FUTMT
               DO FTST
               GOTO EN
 +17      ;
 +18      ;if a test was auto-completed, DGADDF gets set to 0
 +19       IF 'DGADDF
               WRITE !!,*7,"A means test already exists and is in effect"
               GOTO EN
 +20      ;
 +21       if DGMTYPT=1
               KILL DGDOM1
 +22       IF DGMTYPT=2
               DO EN^DGMTCOR
               IF 'DGMTCOR
                   SET I=$PIECE($TEXT(WHY+DGWRT),";",3,99)
                   WRITE !!,*7,"A copay exemption test can only be added for applicable veterans.",!,I
                   GOTO EN
 +23       SET DGLDT=$$LST^DGMTU(DFN,"",DGMTYPT)
           SET DGLD=$PIECE(DGLDT,U,2)
           SET DGLDYR=$EXTRACT(DGLD,1,3)_"1231"
 +24      ;
DT         SET %DT("A")="DATE OF TEST: "
           SET %DT="AEX"
           SET %DT(0)="-NOW"
           SET %DT("B")="NOW"
           WRITE !
           DO ^%DT
           KILL %DT
           if Y<0
               GOTO Q
           SET DGMTDT=Y
 +1        IF DGMTDT<$SELECT(DGMTYPT=1:2860701,1:2921029)
               WRITE !?3,*7,"The date of test cannot be before "_$SELECT(DGMTYPT=1:"7/1/1986.",1:"10/29/1992.")
               GOTO DT
 +2        IF DGLD
               IF DGMTDT<DGLD
                   WRITE !?3,*7,"The date of test cannot be before the last date of test on "
                   SET Y=DGLD
                   XECUTE ^DD("DD")
                   WRITE Y,"."
                   GOTO DT
 +3        IF DGLD
               SET X1=DGMTDT
               SET X2=DGLD
               DO ^%DTC
               IF X<365
                   IF DGMTDT'>DGLDYR
                       Begin DoDot:1
 +4                        WRITE !?3,*7,"An annual date of test already exists on "
                           SET Y=DGLD
                           XECUTE ^DD("DD")
                           WRITE Y,"."
 +5                        SET DGTTYP=$SELECT(DGMTYPT=1:"Means ",1:"Copay Exemption ")
 +6                        WRITE !,$SELECT($PIECE($GET(^DG(408.34,+$PIECE($GET(^DGMT(408.31,+DGLDT,0)),U,23),0)),U)="VAMC":"   Use the 'Edit an Existing "_DGTTYP_"Test' Option.",1:"   Use the 'View a Past Means Test' Option.")
                       End DoDot:1
                       GOTO EN
 +7       ;
 +8       ;Means Test cannot be added for patient on a DOM ward on date of test
 +9        IF DGMTYPT=2
               GOTO PRINT
 +10       NEW VAINDT,VADMVT,DGDOM,DGDOM1
 +11       SET VAINDT=DGMTDT
 +12       DO DOM1^DGMTR
           IF $GET(DGDOM1)
               Begin DoDot:1
 +13               WRITE !,*7,"A Means Test cannot be added for patients on a DOM ward on date of test.",!
               End DoDot:1
               KILL VAINDT,VADMVT,DGDOM,DGDOM1
               GOTO EN
 +14       KILL VAINDT,VADMVT,DGDOM,DGDOM1
 +15      ;
 +16      ;A warning message is displayed if last means test for patient is
 +17      ;from a prior year and has a status of required.  The user is given
 +18      ;the option to continue or stop adding a new means test.
 +19       NEW %
 +20       IF DGLD
               IF DGMTDT>DGLDYR
                   IF $PIECE(DGLDT,"^",4)="R"
                       Begin DoDot:1
 +21                       WRITE !?3,*7,"WARNING - last means test on "
                           SET Y=DGLD
                           XECUTE ^DD("DD")
                           WRITE Y," has a status of required."
DT2                        WRITE !?3,"Do you still want to continue adding new test"
 +1                        SET %=2
                           DO YN^DICN
 +2                        IF %=0
                               WRITE !?3,"Answer 'Y'es to continue adding new test."
                               GOTO DT2
 +3                        QUIT 
                       End DoDot:1
                       if %=-1
                           QUIT 
                       IF %=2
                           KILL %
                           GOTO EN
 +4        KILL %
 +5       ;
PRINT      IF "^P^A^C^G^"[(U_$PIECE(DGLDT,U,4)_U)
               SET %=1
               WRITE !,"Do you wish to print the prior means test"
               DO YN^DICN
               if %=-1
                   GOTO Q
               IF %Y["?"
                   WRITE !!,"This will print the prior means test information.",!
                   GOTO PRINT
 +1        IF $GET(%)=1
               SET DGX=DGMTDT
               SET DGMTDT=DGLD
               SET DGMTI=+DGLDT
               SET DGOPT=""
               DO DEV^DGMTP
               DO CLOSE^DGUTQ
               SET DGMTDT=DGX
               KILL DGX
 +2        DO ADD
           if DGMTI<0
               GOTO EN
 +3        SET DGMTACT="ADD"
           SET DGMTROU="EN^DGMTA"
           GOTO EN^DGMTSC
 +4       ;
Q          KILL DA,DFN,DGADDF,DGBL,DGFL,DGFLD,DGIRO,DGLD,DGLDT,DGLDYR,DGMTACT,DGMTCOR,DGMTDT,DGMTI,DGMTROU,DGREQF,DGTTYP,DGMTYPT,DGVI,DGVO,X,X1,X2,Y
 +1       ;
 +2       ; release lock used to synchronize local MT/CT options with income test upload
 +3        IF $DATA(DGMTDFN)#2
               DO UNLOCK^DGMTUTL(DGMTDFN)
               KILL DGMTDFN
 +4        QUIT 
 +5       ;
ADD       ;Add means test
 +1       ; Input  -- DFN     Patient IEN
 +2       ;           DGMTDT  Date
 +3       ;           DGMTYPT Type of Test 1=MT 2=COPAY 4=LTC
 +4       ; Output -- DGMTI   Annual Means/Copay/LTC Test IEN
 +5        NEW DA,DD,DIC,DIK,DINUM,DLAYGO,DO,DS,X,D0,DGSITE,CONVRT,CURIEN,LINK,DGLNKMT
 +6       ;
 +7       ; obtain lock used to synchronize local MT/CT options with income test upload
 +8        IF $$LOCK^DGMTUTL(DFN)
              IF '$TEST
                   QUIT 
 +9       ;
 +10      ; Check for Linked test and don't lose the link.
 +11       SET LINK=""
           SET DGLNKMT=$$LST^DGMTU(DFN,DGMTDT,DGMTYPT)
           SET CURIEN=+DGLNKMT
 +12       IF CURIEN
               Begin DoDot:1
 +13      ;Don't link test if it's in a different year (DG*5.3*661)
 +14               IF $EXTRACT($PIECE(DGLNKMT,U,2),1,3)'=$EXTRACT(DGMTDT,1,3)
                       QUIT 
 +15               SET LINK=$PIECE($GET(^DGMT(408.31,CURIEN,2)),U,6)
               End DoDot:1
 +16      ;
 +17       SET DGSITE=$$GETSITE^DGMTU4(.DUZ)
 +18       SET X=DGMTDT
           SET (DIC,DIK)="^DGMT(408.31,"
           SET DIC(0)="L"
           SET DLAYGO=408.31
 +19      ;
 +20      ;
 +21      ;Look for existing IAI records and convert (if necessary)
 +22      ;ALL only returns IAI from last IY
           DO ALL^DGMTU21(DFN,"VSD",DT,"IPR")
 +23       IF $DATA(DGINC)
               Begin DoDot:1
 +24               DO ISCNVRT^DGMTUTL(.DGINC)
               End DoDot:1
 +25      ;
 +26      ; The DIC("DR") string is built in this specific order so that
 +27      ; all triggers and "M" x-refs fire correctly.  Should not be
 +28      ; modified without an in-depth review of DD of file #408.31.
 +29      ;
 +30       IF DGMTYPT=2
               Begin DoDot:1
 +31               SET DIC("DR")="2////"_(DGMTYPT'=4)_";2.05////"_DGSITE_";2.06////"_LINK
 +32               SET DIC("DR")=DIC("DR")_";.02////"_DFN_";.019////"_DGMTYPT
 +33      ;DG*5.3*996
                   SET DIC("DR")=DIC("DR")_$SELECT('$GET(SRCTST):";.23////1",1:";.23////"_SRCTST)
               End DoDot:1
 +34      IF '$TEST
               Begin DoDot:1
 +35               SET DIC("DR")="2////"_(DGMTYPT'=4)_";2.05////"_DGSITE_";2.06////"_LINK
 +36               SET DIC("DR")=DIC("DR")_";.019////"_DGMTYPT_";.02////"_DFN
 +37      ;DG*5.3*996
                   SET DIC("DR")=DIC("DR")_$SELECT('$GET(SRCTST):";.23////1",1:";.23////"_SRCTST)
               End DoDot:1
 +38       KILL DD,DO
 +39       DO FILE^DICN
           SET DGMTI=+Y
 +40      ;
 +41      ; Check for another test in the current year and convert IAI records if needed
 +42      ; Send new test date (as test that have) into VRCHKUP
 +43       IF $DATA(TYPE)
               IF ((+TYPE=1)!(TYPE=4))
                   SET CONVRT=$$VRCHKUP^DGMTU2(DGMTYPT,TYPE,DGMTDT)
 +44       IF $DATA(TYPE)
               IF ((+TYPE'=1)&(TYPE'=4))
                   SET CONVRT=$$VRCHKUP^DGMTU2(DGMTYPT,,DGMTDT)
 +45       IF '$DATA(TYPE)
               SET CONVRT=$$VRCHKUP^DGMTU2(DGMTYPT,,DGMTDT)
 +46       NEW DGERR,DGMTRT
 +47       SET DGMTRT(408.31,DGMTI_",",2.11)=1
 +48       SET DGERR=""
 +49       DO FILE^DIE("","DGMTRT",DGERR)
 +50      ; release lock used to synchronize local MT/CT options with income test upload
 +51       DO UNLOCK^DGMTUTL(DFN)
 +52      ;
ADDQ       QUIT 
 +1       ;
FTST      ; Build message for future tests that are added to the system, but
 +1       ; were not performed by the VAMC trying to add a new MT.
 +2        NEW SITE,DGMTYPT,DGTTYP,SRC,SCT
 +3        SET SCT=$PIECE(^DGMT(408.31,+FUTMT,2),U,5)
           SET SITE=$$INST^DGENU()
 +4        SET DGMTYPT=$PIECE(^DGMT(408.31,+FUTMT,0),U,19)
 +5        SET DGTTYP=$SELECT(DGMTYPT=1:"Means ",1:"Copay Exemption ")
 +6        WRITE !?3,*7,"A future test already exists on "
 +7        SET Y=$PIECE(FUTMT,U,2)
           XECUTE ^DD("DD")
           WRITE Y,"."
 +8       ; This site performed the MT
 +9        IF SITE=SCT
               Begin DoDot:1
 +10               WRITE !?3,"Use the 'Edit an Existing "_DGTTYP_"Test' Option."
               End DoDot:1
 +11      ;
 +12      ; The MT was added by another VAMC
 +13       IF SITE'=SCT
               Begin DoDot:1
 +14               SET SRC=$PIECE(FUTMT,U,5)
 +15               IF SCT
                       WRITE !?3,"The "_DGTTYP_"Test was conducted at Site: ",SCT
 +16               WRITE !?3,"Please contact "
 +17               WRITE $SELECT($DATA(^DIC(4,+SCT,0)):$PIECE(^DIC(4,+SCT,0),U),SRC=2:"IVM",SRC=3:"the HEC",1:"the site")
 +18               WRITE ",",!?3,"if it is necessary to edit the test."
               End DoDot:1
 +19       QUIT 
 +20      ; HM DG*5.3*972 - added Medal of Honor to list of reasons
 +21      ; DSB DG*5.3*993- added Registration only
WHY       ;Why Copay Test cannot be added
 +1       ;;Patient is not a veteran.
 +2       ;;Patient does not have a Primary Eligibility Code.
 +3       ;;Patient is Service Connected 50-100%.
 +4       ;;Means Test options must be used instead of Copay options.
 +5       ;;Patient is receiving Aid and Attendance, automatically exempted.
 +6       ;;Patient is receiving Housebound Benefits, automatically exempted.
 +7       ;;Patient is receiving a VA Pension, automatically exempted.
 +8       ;;Patient is in a DOM ward, automatically exempted.
 +9       ;;Patient is an inpatient, automatically exempted.
 +10      ;;Patient was a POW, automatically exempted.
 +11      ;;Patient is Unemployable, automatically exempted.
 +12      ;;Patient is Catastrophically Disabled, automatically exempted.
 +13      ;;Patient is awarded Medal of Honor, automatically exempted.
 +14      ;;Patient's Enrollment Status is REGISTRATION ONLY.