ACDCNV ;IHS/ADC/EDE/KML - CONVERT CS 3TO4, 4TO3; [ 07/06/1999 4:22 PM ]
;;4.1;CHEMICAL DEPENDENCY MIS;**2**;MAY 11, 1998
; Modified for Y2k compliance IHS/DSD/HJT 6/22/1999
;
; This routine converts CS visits from v3 to v4 style, and from
; v4 to v3 style, depending on the passed parameter.
;
EP(ACDDIR) ;EP
; acddir determines direction of conversion. 3=v3tov4, 4=v4tov3
D INIT
Q:ACDQ
D CONVERT
D EOJ
Q
;
INIT ; INITIALIZATION
D ^XBKVAR
S ACDQ=1
S ACDDIR=$G(ACDDIR)
I ACDDIR'=+ACDDIR D INITERR Q
I "34"'[ACDDIR D INITERR Q
K ^TMP("ACD",$J)
D ^ACD
S ACDHV=$O(^ACDVIS("A"),-1)
S $P(^ACDVIS(0),U,3)=ACDHV
S ACDQ=0
Q
;
INITERR ; PARAMETER ERROR
W !,"Invalid parameter!",!,*7
Q
;
CONVERT ; CONVERT VISITS
W !,"Converting visits "
S ACDCTR=0
S ACDVIEN=0
F S ACDVIEN=$O(^ACDVIS(ACDVIEN)) Q:'ACDVIEN!(ACDVIEN>ACDHV) I $D(^ACDVIS(ACDVIEN,0)) S ACDVIS=^(0) I $P(ACDVIS,U,4)="CS" D CONVERT2
Q
;
CONVERT2 ; CONVERT ONE CS VISIT
S ACDCTR=ACDCTR+1
W:'(ACDCTR#100) "."
S ACDVDT=$P(ACDVIS,U) ; visit date cyymmdd
S ACDVDT5=$E(ACDVDT,1,5) ; visit date cyymm
S ACDVDAY=+$E(ACDVDT,6,7) ; visit day of the month
S ACDCOMPC=$P(ACDVIS,U,2) ; component code ien
S ACDPAT=$P(ACDVIS,U,5) ; patient ien
S ACDCOMPT=$P(ACDVIS,U,7) ; component type
S ACDBWP=$P($G(^ACDVIS(ACDVIEN,"BWP")),U) ; program back pointer
D @("CONVERT"_ACDDIR)
Q
;
CONVERT3 ; CONVERT V3 TO V4 (this label used in indirect do)
S ACDFV=0
I '$D(^TMP("ACD",$J,ACDBWP,ACDPAT,ACDCOMPC,ACDCOMPT,ACDVDT5)) D FIXVSIT
S ACDVTOV=^TMP("ACD",$J,ACDBWP,ACDPAT,ACDCOMPC,ACDCOMPT,ACDVDT5)
S ACDCSIEN=0
F S ACDCSIEN=$O(^ACDCS("C",ACDVIEN,ACDCSIEN)) Q:'ACDCSIEN D FIXCS
Q:ACDFV ; quit if first visit for month
S DIK="^ACDVIS(",DA=ACDVIEN D DIK^ACDFMC
Q
;
FIXVSIT ; FIX VISIT .01 FIELD
S ^TMP("ACD",$J,ACDBWP,ACDPAT,ACDCOMPC,ACDCOMPT,ACDVDT5)=ACDVIEN
Q:$E(ACDVDT,6,7)="00" ; visit already v4 style
;Begin Y2k fix IHS/DSD/HJT 6/22/1999
; The date in this DIE string is sent through %DT without restrictions.
; if, i.e. "10-00" (Oct 2000) is entered it will not evaluate properly
;S DIE="^ACDVIS(",DA=ACDVIEN,DR=".01///"_$E(ACDVDT,4,5)_"-"_$E(ACDVDT,2,3)
;%DT will require a 4-digit year in order to work properly...
S DIE="^ACDVIS(",DA=ACDVIEN,DR=".01///"_$E(ACDVDT,4,5)_"-"_($E(ACDVDT,1,3)+1700) ;Y2000
;End Y2k fix
D DIE^ACDFMC
S ACDFV=1
Q
;
FIXCS ; SET .01 FIELD OF CS AND REPOINT
S DR=""
S:$E(ACDVDT,6,7)'="00" DR=".01///"_ACDVDAY_";"
S DR=DR_"99.99////"_ACDVTOV
S DIE="^ACDCS(",DA=ACDCSIEN
D DIE^ACDFMC
Q
;
CONVERT4 ; CONVERT V4 TO V3 (this label used in indirect do)
Q:$E(ACDVDT,6,7)'="00" ; visit already v3 style
K ^TMP("ACD",$J,"CS DAY")
S ACDCSIEN=0
F S ACDCSIEN=$O(^ACDCS("C",ACDVIEN,ACDCSIEN)) Q:'ACDCSIEN I $D(^ACDCS(ACDCSIEN,0)) S X=^(0),^TMP("ACD",$J,"CS DAY",$P(X,U),ACDCSIEN)=""
S ACDCSDAY=0
F S ACDCSDAY=$O(^TMP("ACD",$J,"CS DAY",ACDCSDAY)) Q:'ACDCSDAY D GENVSIT,REPOINT
S DIK="^ACDVIS(",DA=ACDVIEN D DIK^ACDFMC ; delete 00 day CS visit
Q
;
GENVSIT ; GENERATE NEW VISIT
S X=ACDVDT5_$S($L(ACDCSDAY)=1:"0",1:"")_ACDCSDAY
S DIC="^ACDVIS(",DIC("DR")="",DIC(0)="L",DLAYGO=9002172.1
D FILE^ACDFMC
S ACDNVIEN=+Y
S %X="^ACDVIS("_ACDVIEN_","
S %Y="^ACDVIS("_ACDNVIEN_","
D %XY^%RCR
S X=ACDVDT5_$S($L(ACDCSDAY)=1:"0",1:"")_ACDCSDAY
S $P(^ACDVIS(ACDNVIEN,0),U)=X
S DIK="^ACDVIS(",DA=ACDNVIEN D IX1^DIK
Q
;
REPOINT ; REPOINT CS TO NEW VISIT
S ACDCSIEN=0
F S ACDCSIEN=$O(^TMP("ACD",$J,"CS DAY",ACDCSDAY,ACDCSIEN)) Q:'ACDCSIEN D
. S DIE="^ACDCS(",DA=ACDCSIEN,DR="99.99////"_ACDNVIEN
. D DIE^ACDFMC
. Q
Q
;
EOJ ;
K ^TMP("ACD",$J)
D ^ACDKILL
Q
ACDCNV ;IHS/ADC/EDE/KML - CONVERT CS 3TO4, 4TO3; [ 07/06/1999 4:22 PM ]
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;**2**;MAY 11, 1998
+2 ; Modified for Y2k compliance IHS/DSD/HJT 6/22/1999
+3 ;
+4 ; This routine converts CS visits from v3 to v4 style, and from
+5 ; v4 to v3 style, depending on the passed parameter.
+6 ;
EP(ACDDIR) ;EP
+1 ; acddir determines direction of conversion. 3=v3tov4, 4=v4tov3
+2 DO INIT
+3 IF ACDQ
QUIT
+4 DO CONVERT
+5 DO EOJ
+6 QUIT
+7 ;
INIT ; INITIALIZATION
+1 DO ^XBKVAR
+2 SET ACDQ=1
+3 SET ACDDIR=$GET(ACDDIR)
+4 IF ACDDIR'=+ACDDIR
DO INITERR
QUIT
+5 IF "34"'[ACDDIR
DO INITERR
QUIT
+6 KILL ^TMP("ACD",$JOB)
+7 DO ^ACD
+8 SET ACDHV=$ORDER(^ACDVIS("A"),-1)
+9 SET $PIECE(^ACDVIS(0),U,3)=ACDHV
+10 SET ACDQ=0
+11 QUIT
+12 ;
INITERR ; PARAMETER ERROR
+1 WRITE !,"Invalid parameter!",!,*7
+2 QUIT
+3 ;
CONVERT ; CONVERT VISITS
+1 WRITE !,"Converting visits "
+2 SET ACDCTR=0
+3 SET ACDVIEN=0
+4 FOR
SET ACDVIEN=$ORDER(^ACDVIS(ACDVIEN))
IF 'ACDVIEN!(ACDVIEN>ACDHV)
QUIT
IF $DATA(^ACDVIS(ACDVIEN,0))
SET ACDVIS=^(0)
IF $PIECE(ACDVIS,U,4)="CS"
DO CONVERT2
+5 QUIT
+6 ;
CONVERT2 ; CONVERT ONE CS VISIT
+1 SET ACDCTR=ACDCTR+1
+2 IF '(ACDCTR#100)
WRITE "."
+3 ; visit date cyymmdd
SET ACDVDT=$PIECE(ACDVIS,U)
+4 ; visit date cyymm
SET ACDVDT5=$EXTRACT(ACDVDT,1,5)
+5 ; visit day of the month
SET ACDVDAY=+$EXTRACT(ACDVDT,6,7)
+6 ; component code ien
SET ACDCOMPC=$PIECE(ACDVIS,U,2)
+7 ; patient ien
SET ACDPAT=$PIECE(ACDVIS,U,5)
+8 ; component type
SET ACDCOMPT=$PIECE(ACDVIS,U,7)
+9 ; program back pointer
SET ACDBWP=$PIECE($GET(^ACDVIS(ACDVIEN,"BWP")),U)
+10 DO @("CONVERT"_ACDDIR)
+11 QUIT
+12 ;
CONVERT3 ; CONVERT V3 TO V4 (this label used in indirect do)
+1 SET ACDFV=0
+2 IF '$DATA(^TMP("ACD",$JOB,ACDBWP,ACDPAT,ACDCOMPC,ACDCOMPT,ACDVDT5))
DO FIXVSIT
+3 SET ACDVTOV=^TMP("ACD",$JOB,ACDBWP,ACDPAT,ACDCOMPC,ACDCOMPT,ACDVDT5)
+4 SET ACDCSIEN=0
+5 FOR
SET ACDCSIEN=$ORDER(^ACDCS("C",ACDVIEN,ACDCSIEN))
IF 'ACDCSIEN
QUIT
DO FIXCS
+6 ; quit if first visit for month
IF ACDFV
QUIT
+7 SET DIK="^ACDVIS("
SET DA=ACDVIEN
DO DIK^ACDFMC
+8 QUIT
+9 ;
FIXVSIT ; FIX VISIT .01 FIELD
+1 SET ^TMP("ACD",$JOB,ACDBWP,ACDPAT,ACDCOMPC,ACDCOMPT,ACDVDT5)=ACDVIEN
+2 ; visit already v4 style
IF $EXTRACT(ACDVDT,6,7)="00"
QUIT
+3 ;Begin Y2k fix IHS/DSD/HJT 6/22/1999
+4 ; The date in this DIE string is sent through %DT without restrictions.
+5 ; if, i.e. "10-00" (Oct 2000) is entered it will not evaluate properly
+6 ;S DIE="^ACDVIS(",DA=ACDVIEN,DR=".01///"_$E(ACDVDT,4,5)_"-"_$E(ACDVDT,2,3)
+7 ;%DT will require a 4-digit year in order to work properly...
+8 ;Y2000
SET DIE="^ACDVIS("
SET DA=ACDVIEN
SET DR=".01///"_$EXTRACT(ACDVDT,4,5)_"-"_($EXTRACT(ACDVDT,1,3)+1700)
+9 ;End Y2k fix
+10 DO DIE^ACDFMC
+11 SET ACDFV=1
+12 QUIT
+13 ;
FIXCS ; SET .01 FIELD OF CS AND REPOINT
+1 SET DR=""
+2 IF $EXTRACT(ACDVDT,6,7)'="00"
SET DR=".01///"_ACDVDAY_";"
+3 SET DR=DR_"99.99////"_ACDVTOV
+4 SET DIE="^ACDCS("
SET DA=ACDCSIEN
+5 DO DIE^ACDFMC
+6 QUIT
+7 ;
CONVERT4 ; CONVERT V4 TO V3 (this label used in indirect do)
+1 ; visit already v3 style
IF $EXTRACT(ACDVDT,6,7)'="00"
QUIT
+2 KILL ^TMP("ACD",$JOB,"CS DAY")
+3 SET ACDCSIEN=0
+4 FOR
SET ACDCSIEN=$ORDER(^ACDCS("C",ACDVIEN,ACDCSIEN))
IF 'ACDCSIEN
QUIT
IF $DATA(^ACDCS(ACDCSIEN,0))
SET X=^(0)
SET ^TMP("ACD",$JOB,"CS DAY",$PIECE(X,U),ACDCSIEN)=""
+5 SET ACDCSDAY=0
+6 FOR
SET ACDCSDAY=$ORDER(^TMP("ACD",$JOB,"CS DAY",ACDCSDAY))
IF 'ACDCSDAY
QUIT
DO GENVSIT
DO REPOINT
+7 ; delete 00 day CS visit
SET DIK="^ACDVIS("
SET DA=ACDVIEN
DO DIK^ACDFMC
+8 QUIT
+9 ;
GENVSIT ; GENERATE NEW VISIT
+1 SET X=ACDVDT5_$SELECT($LENGTH(ACDCSDAY)=1:"0",1:"")_ACDCSDAY
+2 SET DIC="^ACDVIS("
SET DIC("DR")=""
SET DIC(0)="L"
SET DLAYGO=9002172.1
+3 DO FILE^ACDFMC
+4 SET ACDNVIEN=+Y
+5 SET %X="^ACDVIS("_ACDVIEN_","
+6 SET %Y="^ACDVIS("_ACDNVIEN_","
+7 DO %XY^%RCR
+8 SET X=ACDVDT5_$SELECT($LENGTH(ACDCSDAY)=1:"0",1:"")_ACDCSDAY
+9 SET $PIECE(^ACDVIS(ACDNVIEN,0),U)=X
+10 SET DIK="^ACDVIS("
SET DA=ACDNVIEN
DO IX1^DIK
+11 QUIT
+12 ;
REPOINT ; REPOINT CS TO NEW VISIT
+1 SET ACDCSIEN=0
+2 FOR
SET ACDCSIEN=$ORDER(^TMP("ACD",$JOB,"CS DAY",ACDCSDAY,ACDCSIEN))
IF 'ACDCSIEN
QUIT
Begin DoDot:1
+3 SET DIE="^ACDCS("
SET DA=ACDCSIEN
SET DR="99.99////"_ACDNVIEN
+4 DO DIE^ACDFMC
+5 QUIT
End DoDot:1
+6 QUIT
+7 ;
EOJ ;
+1 KILL ^TMP("ACD",$JOB)
+2 DO ^ACDKILL
+3 QUIT
