| [613] | 1 | DGMTDEL ;ALB/TET,RMO,CAW,LD,SCG - DELETE MEANS TEST for a Patient ;5/11/92 09:40
|
|---|
| 2 | ;;5.3;Registration;**33,45,182,344,407,433**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;Entry point to delete means test
|
|---|
| 5 | I '$D(^XUSEC("DG MTDELETE",+DUZ)) W !!,"ACCESS TO THIS OPTION IS RESTRICTED!!",*7 G EXIT
|
|---|
| 6 | F I=1:1 S J=$P($T(TXT+I),";;",2) Q:J="END" W !,J
|
|---|
| 7 | ; - if type of test = means test, diplay MT text
|
|---|
| 8 | I DGMTYPT=1 F I=1:1 S J=$P($T(MTTXT+I),";;",2) Q:J="END" W !,J
|
|---|
| 9 | ; - if type of test = copay test, display CT text
|
|---|
| 10 | I DGMTYPT=2 F I=1:1 S J=$P($T(CTTXT+I),";;",2) Q:J="END" W !,J
|
|---|
| 11 | ; - if type of test = LTC copay exemption test, display LTC text
|
|---|
| 12 | I DGMTYPT=4 F I=1:1 S J=$P($T(LTCTXT+I),";;",2) Q:J="END" W !,J
|
|---|
| 13 | ;
|
|---|
| 14 | LKP ;Patient lookup
|
|---|
| 15 | N DGMDOD,DGFLG
|
|---|
| 16 | D HOME^%ZIS S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G:$D(DTOUT)!($D(DUOUT))!(+Y<0) EXIT
|
|---|
| 17 | I '$O(^DGMT(408.31,"AD",DGMTYPT,+Y,0)) W !?5,$P(Y(0),U)," has no "_$S(DGMTYPT=1:"means",DGMTYPT=2:"copay",DGMTYPT=4:"LTC copay exemption",1:"")_" tests on file." K DIC,Y G LKP
|
|---|
| 18 | S DFN=+Y,DGNAM=$P(Y(0),U),DG0=Y(0) K DIC,Y
|
|---|
| 19 | I $P($G(^DPT(DFN,.35)),U)'="" S DGMDOD=$P(^DPT(DFN,.35),U)
|
|---|
| 20 | I $G(DGMDOD) W !,*7,"Patient died on: ",$$FMTE^XLFDT(DGMDOD,"1D") G EXIT
|
|---|
| 21 | W @IOF,"Name: ",$P(DGNAM,U),?40,"DOB: ",$$DATE^DGMTDEL1($P(DG0,U,3)),?60,"PT ID: ",$$PID^DGMTDEL1(DFN),!!!
|
|---|
| 22 | D DIS^DGMTU(DFN) W !!
|
|---|
| 23 | VET ;determine if patient is a vet; set dgnvet flag (1=nonvet,0=vet)
|
|---|
| 24 | S DGNVET=0 ;,DGNVET=+$P($G(^DPT(DFN,.36)),U),DGNVET=$P($G(^DIC(8,DGNVET,0)),U,5),DGNVET=$S(DGNVET="N":1,1:0)
|
|---|
| 25 | S DGNVET=$S($P($G(^DIC(8,+$P($G(^DPT(DFN,.36)),U),0)),U,5)="N":1,1:0)
|
|---|
| 26 | I 'DGNVET S:$G(^DPT(DFN,"VET"))="N" DGNVET=1
|
|---|
| 27 | G:'DGNVET LKM ;Q
|
|---|
| 28 | S DIR("A")="Do you wish to delete all "_$S(DGMTYPT=1:"means",DGMTYPT=2:"copay",DGMTYPT=4:"LTC copay exemption",1:"")_" tests on file for this patient",DIR(0)="Y",DIR("B")="YES" D ^DIR K DIR G LKP:$D(DIRUT),LOOP^DGMTDEL1:Y
|
|---|
| 29 | LKM ;Means test lookup
|
|---|
| 30 | S DIC("W")="D ID^DGMTDEL1",DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,19)=DGMTYPT"
|
|---|
| 31 | W ! S DIC="^DGMT(408.31,",DIC(0)="EQZ",X=DFN,D="C" D IX^DIC K DIC I X["?" W !,"Enter appropriate corresponding number." G LKM
|
|---|
| 32 | G LKP:$D(DTOUT)!($D(DUOUT))!(+Y<0)
|
|---|
| 33 | I DGMTYPT=1!(DGMTYPT=2) D G:$G(DGFLG) LKP
|
|---|
| 34 | .I ('$P($G(^DG(408.34,+$P(Y(0),"^",23),0)),U,2))!('$P($G(^DGMT(408.31,+Y,"PRIM")),"^")) W !?5,*7,"This "_$S(DGMTYPT=1:"means",DGMTYPT=2:"copay")_" test is uneditable and cannot be deleted." S DGFLG=1
|
|---|
| 35 | I DGMTYPT=4 D G:$G(DGFLG) LKP
|
|---|
| 36 | . I '$P($G(^DG(408.34,+$P(Y(0),"^",23),0)),U,2) W !,?5,*7,"This LTC Copay Exemption Test is uneditable and cannot be deleted." S DGFLG=1
|
|---|
| 37 | S DGMTI=+Y,DGMT0=Y(0) D VAR^DGMTDEL1 K DIC,Y
|
|---|
| 38 | S DIR("A")="Are you sure you want to delete the "_$$DATE^DGMTDEL1(DGMTD)_" test date",DIR(0)="Y",DIR("B")="NO"
|
|---|
| 39 | D ^DIR K DIR G LKP:$D(DIRUT)!('Y) D DEL^DGMTDEL1 W !,$S(DGMTYPT=1:"Means",DGMTYPT=2:"Copay",DGMTYPT=4:"LTC copay exemption",1:"")_" test deleted."
|
|---|
| 40 | S DGMT=$$LST^DGMTU(DFN,"",DGMTYPT) I DGMTYPT=1,DGMT]"",$P(DGMT,U,2)<DGMTD D
|
|---|
| 41 | .Q:$P(DGMT,U,4)=$P(DGCAT,U,2)
|
|---|
| 42 | .W !,"Previous Means Test Category of '",$P(DGCAT,U),"'",!," has been changed to '",$P(DGMT,U,3),"'"
|
|---|
| 43 | .S DGMTACT="CAT",DGMTP=DGP,DGMTI=+DGMT D AFTER^DGMTEVT
|
|---|
| 44 | .S DGMTINF=0 D EN^DGMTEVT
|
|---|
| 45 | EXIT K DFN,DGCAT,DGCT,DGI,DGN,DGNAM,DGNVET,DGP,DG0,DGMT,DGMTA,DGMTACT,DGMTD,DGMTI,DGMTINF,DGMTSRC,DGMTY,DGMT0,DGMTYPT,DGMTATYP
|
|---|
| 46 | K D,DA,DIC,DIE,DIK,DIR,DIRUT,DTOUT,DUOUT,DGMTA,DGMTP,I,J,VA,VADAT,VADATE,X,Y
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | TXT ;informational text displayed to user
|
|---|
| 50 | ;;
|
|---|
| 51 | ;;This option is used to delete financial test data which may have been
|
|---|
| 52 | ;;inadvertantly entered. Under normal circumstances only individual
|
|---|
| 53 | ;;dates of test may be deleted using this option. The exception is
|
|---|
| 54 | ;;non-veterans. All financial tests found for a non-veteran may be
|
|---|
| 55 | ;;deleted.
|
|---|
| 56 | ;;END
|
|---|
| 57 | MTTXT ;informational text displayed to user if type of test = means test
|
|---|
| 58 | ;;
|
|---|
| 59 | ;;A means test may not be deleted under the following conditions:
|
|---|
| 60 | ;; 1) The means test is an uploaded test from the IVM Center.
|
|---|
| 61 | ;; 2) The means test is a test that was done at the VAMC but has
|
|---|
| 62 | ;; an associated uploaded means test from the IVM Center.
|
|---|
| 63 | ;;END
|
|---|
| 64 | CTTXT ;informational text displayed to user if type of test = copay test
|
|---|
| 65 | ;;
|
|---|
| 66 | ;;A copay test may not be deleted under the following conditions:
|
|---|
| 67 | ;; 1) The copay test is an uploaded test from the IVM Center.
|
|---|
| 68 | ;; 2) The copay test is a test that was done at the VAMC but has
|
|---|
| 69 | ;; an associated uploaded copay test from the IVM Center.
|
|---|
| 70 | ;;END
|
|---|
| 71 | LTCTXT ;informational text displayed to user if type of test = LTC copay test
|
|---|
| 72 | ;;
|
|---|
| 73 | ;;A LTC copay exemption test may not be deleted under the following conditions:
|
|---|
| 74 | ;; 1) The LTC copay exemption test is an uploaded test from the IVM Center.
|
|---|
| 75 | ;;END
|
|---|
