SDWLFUL1	;;IOFO BAY PINES/TEH - REPAIR/RE-CAL ENROLLE STATUS;06/12/2002 ; 20 Aug 20022:10 PM
	;;5.3;scheduling;**525**;AUG 13 1993;Build 47
	;
	;
	;
	;       TEMPORARY FILE:
	;                                              1ST PECE         3RD PIECE        4TH PIECE
	;       ^SDWL(409.39,$J,EWL_IEN,PAT_IEN)=ENROLLE CAL TF ^ ENROLLE CAL API ^ ENROLLE CAL VSSC ^ CURRENT CAL
	;       
	;       
	;      
	;       
	;       
	;       
	;
EN	;
	I $D(^XTMP("SDWLFULSTAT",$J,3)) W !,"You have already run this OPTION." Q
	I '$D(^XTMP("SDWLFULSTAT",$J,2)) W !,"You must run OPTION 2 before OPTION 3." Q
	I '$D(^XTMP("SDWLFULSTAT",$J,"1B")) W !,"You must run a BACK-UP prior to running this option."
	D SETUP S DAX=0 F  S DAX=$O(^SDWL(409.3,DAX)) Q:DAX<1  D
	.I $P(^SDWL(409.3,DAX,0),"^",2)>SDWLSDAT Q
	.I $P(^SDWL(409.3,DAX,0),U,2)="" Q
	.W !,DAX," of ",DAXT," records."
	.S SDWLDFN=+$G(^SDWL(409.3,DAX,0)) I 'SDWLDFN Q
	.S SDWLODT=$P(^SDWL(409.3,DAX,0),U,2),(SDWLODX,X)=SDWLODT D H^%DTC S SDWLODT=%H
	.S SDWLEOLD=$P($G(^SDWL(409.3,DAX,0)),U,20)
	.;NEW ENTRY
	.S SDWLSSN=$$GET1^DIQ(2,SDWLDFN_",",.09)
	.S X=SDWLDFN,DIC(0)="Z",DIC="^SDWL(409.39," D FILE^DICN S SDWLDA=+Y
	.K DA,DIC,DR,DI,DIE,DO,Y
	.S DA=SDWLDA,DR="9////^S X=DAX",DIE="^SDWL(409.39," D ^DIE
	.S DR="4////^S X=SDWLEOLD" D ^DIE
	.K DA,DIC,DR,DI,DIE,DO,X,Y
	.S DIE="^SDWL(409.39,",DR="8////^S X=SDWLODX",DA=SDWLDA D ^DIE
	.K DA,DIC,DR,DI,DO,X,Y
	.S SDWLDE=SDWLODT,SDWLE=1,(SDWLEE,SDWLRNED,SDWLDB)=0
	.D A0,SET
	.D A1,SET
	.D A2,SET
	.S DIE="^SDWL(409.39,"
	.S DA=SDWLDA,SDWLDB=4 S SDWLRNE=SDWLEOLD,DR=SDWLDB_"////^S X=SDWLRNE" D ^DIE
	K DIE,DR,X,Y,DA,DAX,DIK,SDWLD,SDWLDA,SDWLDAT,SDWLDB,SDWLDE,SDWLDET,SDWLDFN
	K SDWLDS,SDWLDTT,SDWLE,SDWLEE,SDWLEOLD,SDWLODT,SDWLODX,SDWLRNE,SDWLRNED,SDWLSDAT
	K SDWLSSN,SDWLTDT,SDWLX,SDWLY,DAXT,%H,SDWLF,SDWLSET,SDWLXX
	S ^XTMP("SDWLFULSTAT",$J,3)=""
	Q
SET	S SDWLRNE=$S(SDWLE=1:"N",SDWLE=2:"E",SDWLE=3:"P",SDWLE=4:"U",1:"U"),DIE="^SDWL(409.39,",DA=SDWLDA
SET1	S DR=SDWLDB_"////^S X=SDWLRNE" D ^DIE
SET2	S DR=SDWLDB+4_"////^S X=SDWLDAT" D ^DIE
	S SDWLX=$G(^SDWL(409.39,SDWLDA,0)),SDWLF=0,SDWLSET=""
	S SDWLXX=$P(SDWLX,"^",2,4) I SDWLXX["E" S SDWLSET="E" D SET3 S SDWLF=1 Q
	I 'SDWLF,SDWLXX["P" S SDWLSET="P" D SET3 S SDWLF=1 Q
	I 'SDWLF,SDWLXX["N" S SDWLSET="N" D SET3 S SDWLF=1 Q
	I 'SDWLF S SDWLXX="U" S SDWLSET="U" D SET3 Q
	Q
SET3	S DR="8.1////^S X=SDWLSET",DIE=409.39,DA=SDWLDA D ^DIE
	K DIE,DR,X,Y,DA
	Q
A0	;GET TREATMENT DATE FROM TREATING FACILITY FILE
	I '$D(^DGCN(391.91,"B",SDWLDFN)) S SDWLDB=1,SDWLDAT="" S SDWLE="" Q
	S SDWLX="",SDWLDAT="",SDWLDB=1,SDWLE=1 F  S SDWLX=$O(^DGCN(391.91,"B",SDWLDFN,SDWLX)) Q:SDWLX=""  D
	.S SDWLY=$G(^DGCN(391.91,SDWLX,0)) D
	..;CHECK FOR VALID TF
	..I $$TF^XUAF4(+$P(SDWLY,U,2)) D
	...;GET LIST OF DATES FOR TF
	...S SDWLD=$P(SDWLY,U,3) S X=SDWLD D H^%DTC I %H>SDWLODT S SDWLD=0 Q
	...I SDWLD S SDWLDTF(9999999-SDWLD)=SDWLX
	;FIND LAST TREATMENT DATE
	I '$D(SDWLDTF) Q
	S SDWLDTF=$O(SDWLDTF(0)) I SDWLDTF S (SDWLDAT,X)=9999999-SDWLDTF D H^%DTC
	S SDWLEE=SDWLDE-%H,SDWLDB=1 I SDWLEE<730 S SDWLE=2
	I $D(SDWLEE),SDWLEE>730!(SDWLEE=730) S SDWLE=3
	K SDWLDTF
	Q
A1	;GET DATE FROM PATIENT ENROLLMENT
	S SDWLDB=2,SDWLDAT="" G A1B:SDWLE=2
	S SDWLRNE=$$ENROLL^EASWTAPI(SDWLDFN) G A1A:$P(SDWLRNE,U,4)="A" S SDWLRNED=$P(SDWLRNE,U,3) D
	.S X=SDWLRNE D H^%DTC
	.I %H>SDWLODT S SDWLRNED=0
	I SDWLRNED S (SDWLDAT,X)=SDWLRNED D H^%DTC S SDWLDS=%H S SDWLDE=SDWLODT,SDWLDET=SDWLDE-SDWLDS,SDWLDB=2 I SDWLDET<366 S SDWLE=1
	I $D(SDWLDET),SDWLDET>365 S SDWLE=3
	I 'SDWLRNE S SDWLE=4
A1A	I $D(SDWLRNE),$P(SDWLRNE,U,4)="A" D
	.I $D(SDWLEE),SDWLEE>730!(SDWLEE=730) S SDWLE=4 Q
	.I 'SDWLEE S SDWLE=4 Q
A1B	Q
A2	;GET TREATMENT DATE FROM VSSC FILE
	S SDWLDTT=SDWLODX,SDWLDE=SDWLODT,SDWLDB=3,SDWLDAT="",SDWLE="" D
	.I '$D(^XTMP("SDWLFUL",$J,SDWLSSN,SDWLDTT)) Q
	.S SDWLTDT=+$G(^XTMP("SDWLFUL",$J,SDWLSSN,SDWLDTT)),X=SDWLTDT D H^%DTC I %H'>SDWLODT D
	..S SDWLDAT=SDWLTDT,SDWLEE=SDWLDE-%H,SDWLDB=3 I SDWLEE<730 S SDWLE=2
	..I $D(SDWLEE),SDWLEE>730!(SDWLEE=730) S SDWLE=3
	Q
KILL	S DA=0 F  S DA=$O(^SDWL(409.39,DA)) Q:DA<1  S DIK="^SDWL(409.39," D ^DIK
	Q
SETUP	S X=^DIC(409.39,0) K ^SDWL(409.39) S ^SDWL(409.39,0)=X
	S SDWLX=$O(^XPD(9.7,"B","SD*5.3*485",999999999),-1)
	S SDWLSDAT=+$P(^XPD(9.7,SDWLX,0),"^",3)
	S DAXT=$P($G(^SDWL(409.3,0)),U,4)