ACDCNV.m

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