| [613] | 1 | DGREGE ;ALB/JDS - EDIT REGISTRATIONS/DISPOSITIONS ; 04/30/2004
|
|---|
| 2 | ;;5.3;Registration;**24,161,151,459,568**;Aug 13, 1993
|
|---|
| 3 | N SDISHDL
|
|---|
| 4 | A W !! S DIC=2,DIC(0)="AEQM" D ^DIC K DIC G Q:Y<0 S (DFN,DA)=+Y
|
|---|
| 5 | I '$O(^DPT(DA,"DIS",0)) W !!,"No registrations to print from.",!! G A
|
|---|
| 6 | F11 R !!,"Registration date/time: ",X:DTIME G A:'$T!(X?1"^".E)!(X=""),NUM:$L(X)<7 S %DT="T" D ^%DT S DFN1=9999999-Y G W1:$D(^DPT(DA,"DIS",DFN1)) W !!
|
|---|
| 7 | HELP W ! S J=0 F I=0:0 S I=$O(^DPT(DA,"DIS",I)) Q:'I S J=J+1,L=+(^(I,0))_"00000" W $J(J,2),". ",$$FMTE^XLFDT($E(L,1,12),"5Z") W ?$X\40+1*40 W:$X>75 ! Q:J>20
|
|---|
| 8 | W !,"Enter the date and time, Entry #, or 'L' for the last registration,",!," to select the registration you wish to edit" G F11
|
|---|
| 9 | NUM ; choose by number of find last registration
|
|---|
| 10 | S DFN1=0
|
|---|
| 11 | I X="L" S DFN1=$O(^DPT(DA,"DIS",0)) ; get last
|
|---|
| 12 | F I=1:1:+X S DFN1=$O(^DPT(DA,"DIS",DFN1)) Q:'DFN1
|
|---|
| 13 | G HELP:'DFN1
|
|---|
| 14 | W " ",$$FMTE^XLFDT(9999999-DFN1,"5Z"),!!
|
|---|
| 15 | W1 S DA=DFN1,DA(1)=DFN,L=$G(^DPT(DFN,"DIS",DFN1,0)),DP=2.101,DR=$S($P(L,U,6):"[DGREGE]",1:"[DGREGEO]")
|
|---|
| 16 | I $P(L,U,18) S (SDISHDL,^TMP("SDEVT HANDLE",$J))=$G(^TMP("SDEVT HANDLE",$J))+1 D BEFORE^DGDIS(DFN,9999999-DFN1,9,SDISHDL)
|
|---|
| 17 | S DIE="^DPT(",DA=DFN D ^DIE K DE,DQ,DIE,DR S DIE="^DPT("_DFN_",""DIS"",",DGXXXD=0 D EL
|
|---|
| 18 | N DGL
|
|---|
| 19 | S DGL=$G(^DPT(DFN,"DIS",DFN1,0))
|
|---|
| 20 | I $P(DGL,U,18) D
|
|---|
| 21 | . I "^0^1^"[(U_$P(DGL,U,2)_U),$P(DGL,U,6) D CO(DFN,9999999-DFN1,SDISHDL)
|
|---|
| 22 | . D EVT^DGDIS(DFN,9999999-DFN1,9,SDISHDL)
|
|---|
| 23 | . D VALIDATE^DGDIS(DFN,DFN1) ; -- call c/o validator
|
|---|
| 24 | G A
|
|---|
| 25 | ;
|
|---|
| 26 | Q K %,%H,%X,%Y,C,D0,D1,DA,DFN,DFN1,DIE,DP,I,J,L,X,Y
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | DT I Y X ^DD("DD") W Y
|
|---|
| 30 | Q
|
|---|
| 31 | EL W !!,"Updating eligibility status for this registration...",!
|
|---|
| 32 | S DA=DFN1,DIE("NO^")="",DA(1)=DFN,DP=2.101,DGXXX=$S($D(^DPT(DFN,.361)):$P(^(.361),"^",1),1:""),DGXXX1=$S($D(^DPT(DFN,"DIS",DFN1,0)):^(0),1:"") Q:'DGXXX1 S DGXXX2=+$P(DGXXX1,"^",13),DR="14///"_$S(DGXXX="V":1,1:0)
|
|---|
| 33 | I $D(^DIC(8,DGXXX2,0)),$P(^(0),"^",5)="Y",$P(^(0),"^",4)=1!($P(^(0),"^",4)=3) S DGXXX3=$S($D(^DPT(DFN,.3)):$P(^(.3),"^",2),1:""),DR=DR_";15///1;16//"_DGXXX3
|
|---|
| 34 | E S DR=DR_";15///NO"
|
|---|
| 35 | S:$P(DGXXX1,"^",17) DR=DR_";17///@" D ^DIE G ELQ:DGXXXD
|
|---|
| 36 | S DGXXXD=0 D SEG^DGA4004 I DGSEG W !!,"Disposition on AMIS Segment ",DGSEG," - ",$S($D(^DG(391.1,+DGSEG,0)):$P(^(0),"^",1),1:"SEGMENT NAME UNKNOWN") K DR S DR="17///"_DGSEG D ^DIE K DE,DQ,DIE,DR
|
|---|
| 37 | E W !!,"Patient falls into a means test category...AMIS 401-420 segment will be",!,"determined at time the report is generated..."
|
|---|
| 38 | ELQ W ! K DGXXX,DGXXX1,DGXXX2,DGXXX3,DGXXXD,DR,DIE("NO^"),DGSEG Q
|
|---|
| 39 | ;
|
|---|
| 40 | CO(DFN,SDDT,SDISHDL) ; -- ask check out questions
|
|---|
| 41 | N DFN1,SDCOQUIT,SDIS,SDOE,SDPMTDF
|
|---|
| 42 | S SDOE=$$GETDISP^SDVSIT2(DFN,SDDT) G COQ:'SDOE
|
|---|
| 43 | S SDIS=$G(^DPT(DFN,"DIS",9999999-SDDT,0))
|
|---|
| 44 | I '$$SCE^DGSDU(+SDOE,7,0)!($P($G(^TMP("SDEVT",$J,SDISHDL,3,"DIS",0,"BEFORE")),"^",13)'=$P(SDIS,"^",13)) D INT^SDCO6(SDOE,.SDCOQUIT)
|
|---|
| 45 | I '$D(SDCOQUIT) D
|
|---|
| 46 | .S SDPMTDF=$S($P(^DG(43,1,0),"^",32):1,$P($G(^DIC(37,+$P(SDIS,"^",7),0)),"^")="SCHEDULE FUTURE APPOINTMENT":1,1:0)
|
|---|
| 47 | . I $$ASK^SDCO6(SDPMTDF) D EN^SDCO(SDOE,SDISHDL,1)
|
|---|
| 48 | COQ Q
|
|---|
