- 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 Jan 18, 2025@03:45:35 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