DGMTEO ;ALB/RMO,CAW,LD,TDM,BDB - Other Means Test Edit Options ; 8/2/02 11:14am
;;5.3;Registration;**33,45,182,456,858**;Aug 13, 1993;Build 30
;
ADJ ;Entry point to adjudicate a means test
N PADISP,DGLSTDT
S DIC="^DPT(",DIC(0)="AEMQ"
I DGMTYPT=1 S DIC("S")="I $P(^(0),U,14)=2"
I DGMTYPT=2 S DIC("S")="I $D(^DGMT(408.31,""AID"",DGMTYPT,+Y))"
W ! D ^DIC K DIC G ADJQ:Y<0 S DFN=+Y
S DGMTI=+$$LST^DGMTU(DFN,"",DGMTYPT),DGMTS=$P($G(^DGMT(408.31,DGMTI,0)),"^",3)
I "^2^11^"'[("^"_DGMTS_"^") W !?3,*7,"Last means test is not PENDING ADJUDICATION." G ADJ
;DG*5.3*858 user may not adjudicate a means test that is more than 1 year old
S DGLSTDT=$P($G(^DGMT(408.31,DGMTI,0)),"^",1) I $$OLD^DGMTU4(DGLSTDT) W !!,"Please use the Add a New Means Test Option.",!,"User may not adjudicate a Means Test that is more than 1 year old." G ADJ
;
S PADISP=$$PA^DGMTUTL(DGMTI) S:PADISP="" PADISP="UNKNOWN"
W !!,"=============================================="
W !,?3,"Patient pending adjudication for ",PADISP,"."
W !,"=============================================="
;
S DGMTACT="ADJ" D PRIOR^DGMTEVT
S DA=DGMTI,DIE="^DGMT(408.31,",DR="[DGMT ENTER/EDIT ADJUDICATION]" W ! D ^DIE K DA,DIE,DR
D AFTER^DGMTEVT S DGMTINF=0 D EN^DGMTEVT
;
;Update the TEST-DETERMINED STATUS field (#2.03) in the Annual Means
;TEST file (#408.31) when adjudicating a means test.
D SAVESTAT^DGMTU4(DGMTI)
G ADJ
ADJQ K DFN,DGMTA,DGMTACT,DGMTI,DGMTINF,DGMTP,DGMTS,DGMTYPT,Y
Q
;
COM ;Entry point to complete a required means test
S DIC="^DPT(",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,14)=1" W ! D ^DIC K DIC G COMQ:Y<0 S DFN=+Y
S DGMTI=+$$LST^DGMTU(DFN),DGMT0=$G(^DGMT(408.31,DGMTI,0)),DGMTDT=$P(DGMT0,"^")
I $P(DGMT0,"^",3)'=1 W !?3,*7,"Last means test is not REQUIRED." G COM
;DG*5.3*858 user may not complete a means test that is more than 1 year old
I $$OLD^DGMTU4(DGMTDT) W !!,"Please use the Add a New Means Test Option.",!,"User may not complete a Means Test that is more than 1 year old." G COM
S DGMTYPT=1,DGMTACT="COM",DGMTROU="COM^DGMTEO" G EN^DGMTSC
COMQ K DFN,DGMT0,DGMTACT,DGMTDT,DGMTI,DGMTROU,DGMTYPT,Y
Q
;
CAT ;Entry point to change a patient's means test category
;
;no longer allowed to do this - instead, must enter a hardship or
;net-worth adjudication
Q
;
S DIC="^DPT(",DIC(0)="AEMQ",DIC("S")="I ""^1^3^""'[(U_$P(^(0),U,14)_U)" W ! D ^DIC K DIC G CATQ:Y<0 S DFN=+Y
S DGMTI=+$$LST^DGMTU(DFN),DGMTS=$P($G(^DGMT(408.31,DGMTI,0)),"^",3)
I 'DGMTS W !?3,*7,"No means test to change." G CAT
S DGMTACT="CAT" D PRIOR^DGMTEVT
I $G(DGMTP) D
.W !!,"MEANS TEST DATE: ",$$DATE^DGMTOREQ($P(DGMTP,U)),?44,"SOURCE OF TEST: ",$$SR^DGMTAUD1(DGMTP),!
.I $P($G(^DG(408.34,+$P(DGMTP,U,23),0)),U)="VAMC",($P($G(^DG(408.32,+$P(DGMTP,U,3),0)),U)="CATEGORY A") D
..F I=1:1 S J=$P($T(CATTXT+I),";;",2) Q:J="END" W !,J
S DA=DGMTI,DIE="^DGMT(408.31,",DR="[DGMT ENTER/EDIT CATEGORY]" W ! D ^DIE K DA,DIE,DR
S DGMTYPT=1 D AFTER^DGMTEVT S DGMTINF=0 D EN^DGMTEVT,CATQ G CAT
CATQ K DFN,DGMTA,DGMTACT,DGMTDT,DGMTI,DGMTINF,DGMTP,DGMTS,DGMTYPT,I,J,Y
Q
CATTXT ;
;;NOTE: VAMC Category A means tests can be changed to another
;; category by editing the patient's means test data through
;; the 'Edit an Existing Means Test' option ONLY.
;;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTEO 3303 printed Sep 02, 2024@19:30:13 Page 2
DGMTEO ;ALB/RMO,CAW,LD,TDM,BDB - Other Means Test Edit Options ; 8/2/02 11:14am
+1 ;;5.3;Registration;**33,45,182,456,858**;Aug 13, 1993;Build 30
+2 ;
ADJ ;Entry point to adjudicate a means test
+1 NEW PADISP,DGLSTDT
+2 SET DIC="^DPT("
SET DIC(0)="AEMQ"
+3 IF DGMTYPT=1
SET DIC("S")="I $P(^(0),U,14)=2"
+4 IF DGMTYPT=2
SET DIC("S")="I $D(^DGMT(408.31,""AID"",DGMTYPT,+Y))"
+5 WRITE !
DO ^DIC
KILL DIC
if Y<0
GOTO ADJQ
SET DFN=+Y
+6 SET DGMTI=+$$LST^DGMTU(DFN,"",DGMTYPT)
SET DGMTS=$PIECE($GET(^DGMT(408.31,DGMTI,0)),"^",3)
+7 IF "^2^11^"'[("^"_DGMTS_"^")
WRITE !?3,*7,"Last means test is not PENDING ADJUDICATION."
GOTO ADJ
+8 ;DG*5.3*858 user may not adjudicate a means test that is more than 1 year old
+9 SET DGLSTDT=$PIECE($GET(^DGMT(408.31,DGMTI,0)),"^",1)
IF $$OLD^DGMTU4(DGLSTDT)
WRITE !!,"Please use the Add a New Means Test Option.",!,"User may not adjudicate a Means Test that is more than 1 year old."
GOTO ADJ
+10 ;
+11 SET PADISP=$$PA^DGMTUTL(DGMTI)
if PADISP=""
SET PADISP="UNKNOWN"
+12 WRITE !!,"=============================================="
+13 WRITE !,?3,"Patient pending adjudication for ",PADISP,"."
+14 WRITE !,"=============================================="
+15 ;
+16 SET DGMTACT="ADJ"
DO PRIOR^DGMTEVT
+17 SET DA=DGMTI
SET DIE="^DGMT(408.31,"
SET DR="[DGMT ENTER/EDIT ADJUDICATION]"
WRITE !
DO ^DIE
KILL DA,DIE,DR
+18 DO AFTER^DGMTEVT
SET DGMTINF=0
DO EN^DGMTEVT
+19 ;
+20 ;Update the TEST-DETERMINED STATUS field (#2.03) in the Annual Means
+21 ;TEST file (#408.31) when adjudicating a means test.
+22 DO SAVESTAT^DGMTU4(DGMTI)
+23 GOTO ADJ
ADJQ KILL DFN,DGMTA,DGMTACT,DGMTI,DGMTINF,DGMTP,DGMTS,DGMTYPT,Y
+1 QUIT
+2 ;
COM ;Entry point to complete a required means test
+1 SET DIC="^DPT("
SET DIC(0)="AEMQ"
SET DIC("S")="I $P(^(0),U,14)=1"
WRITE !
DO ^DIC
KILL DIC
if Y<0
GOTO COMQ
SET DFN=+Y
+2 SET DGMTI=+$$LST^DGMTU(DFN)
SET DGMT0=$GET(^DGMT(408.31,DGMTI,0))
SET DGMTDT=$PIECE(DGMT0,"^")
+3 IF $PIECE(DGMT0,"^",3)'=1
WRITE !?3,*7,"Last means test is not REQUIRED."
GOTO COM
+4 ;DG*5.3*858 user may not complete a means test that is more than 1 year old
+5 IF $$OLD^DGMTU4(DGMTDT)
WRITE !!,"Please use the Add a New Means Test Option.",!,"User may not complete a Means Test that is more than 1 year old."
GOTO COM
+6 SET DGMTYPT=1
SET DGMTACT="COM"
SET DGMTROU="COM^DGMTEO"
GOTO EN^DGMTSC
COMQ KILL DFN,DGMT0,DGMTACT,DGMTDT,DGMTI,DGMTROU,DGMTYPT,Y
+1 QUIT
+2 ;
CAT ;Entry point to change a patient's means test category
+1 ;
+2 ;no longer allowed to do this - instead, must enter a hardship or
+3 ;net-worth adjudication
+4 QUIT
+5 ;
+6 SET DIC="^DPT("
SET DIC(0)="AEMQ"
SET DIC("S")="I ""^1^3^""'[(U_$P(^(0),U,14)_U)"
WRITE !
DO ^DIC
KILL DIC
if Y<0
GOTO CATQ
SET DFN=+Y
+7 SET DGMTI=+$$LST^DGMTU(DFN)
SET DGMTS=$PIECE($GET(^DGMT(408.31,DGMTI,0)),"^",3)
+8 IF 'DGMTS
WRITE !?3,*7,"No means test to change."
GOTO CAT
+9 SET DGMTACT="CAT"
DO PRIOR^DGMTEVT
+10 IF $GET(DGMTP)
Begin DoDot:1
+11 WRITE !!,"MEANS TEST DATE: ",$$DATE^DGMTOREQ($PIECE(DGMTP,U)),?44,"SOURCE OF TEST: ",$$SR^DGMTAUD1(DGMTP),!
+12 IF $PIECE($GET(^DG(408.34,+$PIECE(DGMTP,U,23),0)),U)="VAMC"
IF ($PIECE($GET(^DG(408.32,+$PIECE(DGMTP,U,3),0)),U)="CATEGORY A")
Begin DoDot:2
+13 FOR I=1:1
SET J=$PIECE($TEXT(CATTXT+I),";;",2)
if J="END"
QUIT
WRITE !,J
End DoDot:2
End DoDot:1
+14 SET DA=DGMTI
SET DIE="^DGMT(408.31,"
SET DR="[DGMT ENTER/EDIT CATEGORY]"
WRITE !
DO ^DIE
KILL DA,DIE,DR
+15 SET DGMTYPT=1
DO AFTER^DGMTEVT
SET DGMTINF=0
DO EN^DGMTEVT
DO CATQ
GOTO CAT
CATQ KILL DFN,DGMTA,DGMTACT,DGMTDT,DGMTI,DGMTINF,DGMTP,DGMTS,DGMTYPT,I,J,Y
+1 QUIT
CATTXT ;
+1 ;;NOTE: VAMC Category A means tests can be changed to another
+2 ;; category by editing the patient's means test data through
+3 ;; the 'Edit an Existing Means Test' option ONLY.
+4 ;;END
