Routine: SCCVCST4

SCCVCST4 ;ALB/TMP - Scheduling Conversion Template Utilities - CST; APR 20, 1998

 ;;5.3;Scheduling;**211**;Aug 13, 1993

RESULT ; Display conversion results message

 N DIR,Y,Z

 I $D(SCERRMSG)!'$G(SCTOT("OK")) D

 . I '$O(SCERRMSG("")) S SCERRMSG(1)="UNKNOWN ERROR"

 . S DIR("A",1)=$S(SCCVEVT=1:"",1:"RE")_"CONVERSION ENCOUNTERED THE FOLLOWING ERROR(S): ",DIR("A",2)=" "

 . S Z=0 F  S Z=$O(SCERRMSG(Z)) Q:'Z  S DIR("A",Z+2)="  "_SCERRMSG(Z)

 E  S DIR("A",1)=$S(SCCVEVT=1:"",1:"RE")_"CONVERSION WAS SUCCESSFUL"

 S DIR(0)="EA",DIR("A")="PRESS RETURN "

 D ^DIR K DIR

NOENT(SCCVTYPN,SCCVDFN,SCDTM) ;No entry was found for date/time/pt

 N DIR,X,Y

 S DIR(0)="EA"

 S DIR("A",1)="No valid "_SCCVTYPN_" was found for "

 S DIR("A",2)="  "_$P($G(^DPT(SCCVDFN,0)),U)_" ("_SCCVDFN_") on "_$$FMTE^XLFDT(SCDTM),DIR("A")="Press RETURN to continue: " D ^DIR K DIR

DISPERR(SCERR,SCF) ; Display error

 N DIR,Y,X,Z,CT

 I $G(SCERR) S SCERR(SCERR)=""

 S Z=$O(SCERR(0)) Q:'Z

 S DIR(0)="EA",DIR("A",1)="INVALID SELECTION: "_$P($T(SCERR+Z),";;",3)

 S CT=1 F  S Z=$O(SCERR(Z)) Q:'Z  S CT=CT+1,DIR("A",CT)=$J("",19)_$P($T(SCERR+Z),";;",3)

 I SCF["SDV",'$D(SCERR(1)) S DIR("A",CT+1)="(Th"_$S(CT>1:"ese errors",1:"is error")_" may apply to one or more of the ADD/EDIT's entries)"

 S DIR("A")="PRESS RETURN TO CONTINUE "

 D ^DIR K DIR

W !

DISP1(SCCVTYPN,SCFILE1,SCCVDA) ; Display selected entry

 N DIC,DR,DIQ,DA,DIR,Y

 W !,SCCVTYPN_" #: "_SCCVDA

 I SCFILE1["SCE" S SCFILE1="^SCE("

 S DIC=SCFILE1,DIQ(0)="R",DA=SCCVDA

 D EN^DIQ

 S DIR(0)="YA",DIR("A")="IS THIS THE CORRECT ENTRY?: ",DIR("B")="NO"

 S DIR("?")="If you say YES here, this entry will be converted"

 D ^DIR K DIR

W !

 Q $P(Y,U)

CONV1(SCCVEVT,SCFILE,SCCVDFN,SCDTM,SCCVDA) ;Convert one entry (appt/disp/add-edit/enctr)

 ; Conversion will include any child encounters

 N SCF,DATA,SCTOT,SCERRMSG,SCCVERRH,SCSTOPF,SCCS

 S SCF=SCFILE

 I SCFILE["SCE" D  ; Encounter - set file for specific origin

 . N SCORG,DATA

 . S DATA=$G(@SCF@(+$G(SCCVDA),0)),SCORG=$P(DATA,U,8)

 . S SCF=$S(SCORG=1:"^DPT("_$P(DATA,U,2)_",""S"")",SCORG=2:"^SDV",SCORG=3:"^DPT("_$P(DATA,U,2)_",""DIS"")",1:"")

 . S (SCCVDA,SCDTM)=+DATA

 . S:SCORG=2 SCCS=+$P(DATA,U,9),SCTOT("A/E")=1

 . S:SCORG=3 SCCVDA=9999999-SCCVDA

 I SCF["""S""" D  G CONVQ ; Appointment

 . S DATA=$G(@SCF@(SCDTM,0)),SCTOT("OK")=""

 . I DATA D

 .. W !,$P("Converting^Reconverting",U,SCCVEVT),"..."

 .. D ZERO^SCCVEAP(SCCVDFN)

 .. D EN^SCCVEAP1(SCCVEVT,SCCVDFN,SCDTM,+DATA,"","")

 . D RESULT

 I SCF["""DIS""" D  G CONVQ ; Disposition

 . S DATA=$G(@SCF@(+$G(SCCVDA),0)),SCTOT("OK")=0

 . I DATA D

 .. W !,$P("Converting^Reconverting",U,SCCVEVT),"..."

 .. D ZERO^SCCVEDI(SCCVDFN)

 .. D EN^SCCVEDI1(SCCVEVT,SCCVDFN,SCDTM,"")

 . D RESULT

 I SCF["SDV" D  G CONVQ ; Add/edit

 . I SCF=SCFILE D  Q  ; Convert whole add/edit

 .. S DATA=$G(@SCF@(SCDTM,0)),SCTOT("OK")=0

 .. I DATA D

 ... W !,$P("Converting^Reconverting",U,SCCVEVT),"..."

 ... D STOPS^SCCVEAE(SCCVEVT,SCDTM,"","","")

 .. D RESULT

. ;

 . I SCF'=SCFILE D  ; Convert one add/edit clinic stop (chosen by enctr)

 .. S DATA=$G(@SCF@(SCDTM,"CS",SCCS,0)),SCTOT("OK")=0

 .. I DATA'="" D

 ... W !,$P("Converting^Reconverting",U,SCCVEVT),"..."

 ... D ZERO^SCCVEAE(SCDTM)

 ... D EN^SCCVEAE1(SCCVEVT,SCDTM,SCCS,"","")

 .. D RESULT

CONVQ Q

SCERR ; Invalid reasons

 ;;1;;THE ENTRY REQUESTED COULD NOT BE FOUND

 ;;2;;DATE OF THE ENTRY MUST BE BEFORE 10/1/96

 ;;3;;ALREADY HAS A VISIT

 ;;4;;ENTRY IS A 'CHILD'

 ;;5;;ENTRY DOES NOT HAVE A VALID DISPOSITION

 ;;6;;APPOINTMENT STATUS IS NOT VALID

 ;;7;;APPOINTMENT IS NOT FOR A VALID CLINIC

 ;;8;;ENTRY WAS NOT PREVIOUSLY CONVERTED

 ;;9;;ENCOUNTER NOT CHECKED OUT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCCVCST4   3769     printed  Feb 19, 2025@00:05                                                                                                                                                                                                       Page 2

SCCVCST4  ;ALB/TMP - Scheduling Conversion Template Utilities - CST; APR 20, 1998

 +1       ;;5.3;Scheduling;**211**;Aug 13, 1993

 +2       ;

RESULT    ; Display conversion results message

 +1       ;

 +2        NEW DIR,Y,Z

 +3        IF $DATA(SCERRMSG)!'$GET(SCTOT("OK"))

               Begin DoDot:1

 +4                IF '$ORDER(SCERRMSG(""))

                       SET SCERRMSG(1)="UNKNOWN ERROR"

 +5                SET DIR("A",1)=$SELECT(SCCVEVT=1:"",1:"RE")_"CONVERSION ENCOUNTERED THE FOLLOWING ERROR(S): "

                   SET DIR("A",2)=" "

 +6                SET Z=0

FOR

                       SET Z=$ORDER(SCERRMSG(Z))

                       if 'Z

                           QUIT

                       SET DIR("A",Z+2)="  "_SCERRMSG(Z)

               End DoDot:1

 +7       IF '$TEST

               SET DIR("A",1)=$SELECT(SCCVEVT=1:"",1:"RE")_"CONVERSION WAS SUCCESSFUL"

 +8        SET DIR(0)="EA"

           SET DIR("A")="PRESS RETURN "

 +9        DO ^DIR

           KILL DIR

 +10       QUIT

 +11      ;

NOENT(SCCVTYPN,SCCVDFN,SCDTM) ;No entry was found for date/time/pt

 +1       ;

 +2        NEW DIR,X,Y

 +3        SET DIR(0)="EA"

 +4        SET DIR("A",1)="No valid "_SCCVTYPN_" was found for "

 +5        SET DIR("A",2)="  "_$PIECE($GET(^DPT(SCCVDFN,0)),U)_" ("_SCCVDFN_") on "_$$FMTE^XLFDT(SCDTM)

           SET DIR("A")="Press RETURN to continue: "

           DO ^DIR

           KILL DIR

 +6        QUIT

 +7       ;

DISPERR(SCERR,SCF) ; Display error

 +1        NEW DIR,Y,X,Z,CT

 +2        IF $GET(SCERR)

               SET SCERR(SCERR)=""

 +3        SET Z=$ORDER(SCERR(0))

           if 'Z

               QUIT

 +4        SET DIR(0)="EA"

           SET DIR("A",1)="INVALID SELECTION: "_$PIECE($TEXT(SCERR+Z),";;",3)

 +5        SET CT=1

FOR

               SET Z=$ORDER(SCERR(Z))

               if 'Z

                   QUIT

               SET CT=CT+1

               SET DIR("A",CT)=$JUSTIFY("",19)_$PIECE($TEXT(SCERR+Z),";;",3)

 +6        IF SCF["SDV"

               IF '$DATA(SCERR(1))

                   SET DIR("A",CT+1)="(Th"_$SELECT(CT>1:"ese errors",1:"is error")_" may apply to one or more of the ADD/EDIT's entries)"

 +7        SET DIR("A")="PRESS RETURN TO CONTINUE "

 +8        DO ^DIR

           KILL DIR

 +9        WRITE !

 +10       QUIT

 +11      ;

DISP1(SCCVTYPN,SCFILE1,SCCVDA) ; Display selected entry

 +1        NEW DIC,DR,DIQ,DA,DIR,Y

 +2        WRITE !,SCCVTYPN_" #: "_SCCVDA

 +3        IF SCFILE1["SCE"

               SET SCFILE1="^SCE("

 +4        SET DIC=SCFILE1

           SET DIQ(0)="R"

           SET DA=SCCVDA

 +5        DO EN^DIQ

 +6        SET DIR(0)="YA"

           SET DIR("A")="IS THIS THE CORRECT ENTRY?: "

           SET DIR("B")="NO"

 +7        SET DIR("?")="If you say YES here, this entry will be converted"

 +8        DO ^DIR

           KILL DIR

 +9        WRITE !

 +10       QUIT $PIECE(Y,U)

 +11      ;

CONV1(SCCVEVT,SCFILE,SCCVDFN,SCDTM,SCCVDA) ;Convert one entry (appt/disp/add-edit/enctr)

 +1       ; Conversion will include any child encounters

 +2        NEW SCF,DATA,SCTOT,SCERRMSG,SCCVERRH,SCSTOPF,SCCS

 +3        SET SCF=SCFILE

 +4       ;

 +5       ; Encounter - set file for specific origin

           IF SCFILE["SCE"

               Begin DoDot:1

 +6                NEW SCORG,DATA

 +7                SET DATA=$GET(@SCF@(+$GET(SCCVDA),0))

                   SET SCORG=$PIECE(DATA,U,8)

 +8                SET SCF=$SELECT(SCORG=1:"^DPT("_$PIECE(DATA,U,2)_",""S"")",SCORG=2:"^SDV",SCORG=3:"^DPT("_$PIECE(DATA,U,2)_",""DIS"")",1:"")

 +9                SET (SCCVDA,SCDTM)=+DATA

 +10               if SCORG=2

                       SET SCCS=+$PIECE(DATA,U,9)

                       SET SCTOT("A/E")=1

 +11               if SCORG=3

                       SET SCCVDA=9999999-SCCVDA

               End DoDot:1

 +12      ;

 +13      ; Appointment

           IF SCF["""S"""

               Begin DoDot:1

 +14               SET DATA=$GET(@SCF@(SCDTM,0))

                   SET SCTOT("OK")=""

 +15               IF DATA

                       Begin DoDot:2

 +16                       WRITE !,$PIECE("Converting^Reconverting",U,SCCVEVT),"..."

 +17                       DO ZERO^SCCVEAP(SCCVDFN)

 +18                       DO EN^SCCVEAP1(SCCVEVT,SCCVDFN,SCDTM,+DATA,"","")

                       End DoDot:2

 +19               DO RESULT

               End DoDot:1

               GOTO CONVQ

 +20      ;

 +21      ; Disposition

           IF SCF["""DIS"""

               Begin DoDot:1

 +22               SET DATA=$GET(@SCF@(+$GET(SCCVDA),0))

                   SET SCTOT("OK")=0

 +23               IF DATA

                       Begin DoDot:2

 +24                       WRITE !,$PIECE("Converting^Reconverting",U,SCCVEVT),"..."

 +25                       DO ZERO^SCCVEDI(SCCVDFN)

 +26                       DO EN^SCCVEDI1(SCCVEVT,SCCVDFN,SCDTM,"")

                       End DoDot:2

 +27               DO RESULT

               End DoDot:1

               GOTO CONVQ

 +28      ;

 +29      ; Add/edit

           IF SCF["SDV"

               Begin DoDot:1

 +30      ; Convert whole add/edit

                   IF SCF=SCFILE

                       Begin DoDot:2

 +31                       SET DATA=$GET(@SCF@(SCDTM,0))

                           SET SCTOT("OK")=0

 +32                       IF DATA

                               Begin DoDot:3

 +33                               WRITE !,$PIECE("Converting^Reconverting",U,SCCVEVT),"..."

 +34                               DO STOPS^SCCVEAE(SCCVEVT,SCDTM,"","","")

                               End DoDot:3

 +35                       DO RESULT

                       End DoDot:2

                       QUIT

 +36      ;

 +37      ; Convert one add/edit clinic stop (chosen by enctr)

                   IF SCF'=SCFILE

                       Begin DoDot:2

 +38                       SET DATA=$GET(@SCF@(SCDTM,"CS",SCCS,0))

                           SET SCTOT("OK")=0

 +39                       IF DATA'=""

                               Begin DoDot:3

 +40                               WRITE !,$PIECE("Converting^Reconverting",U,SCCVEVT),"..."

 +41                               DO ZERO^SCCVEAE(SCDTM)

 +42                               DO EN^SCCVEAE1(SCCVEVT,SCDTM,SCCS,"","")

                               End DoDot:3

 +43                       DO RESULT

                       End DoDot:2

               End DoDot:1

               GOTO CONVQ

CONVQ      QUIT

 +1       ;

 +2       ;

SCERR     ; Invalid reasons

 +1       ;;1;;THE ENTRY REQUESTED COULD NOT BE FOUND

 +2       ;;2;;DATE OF THE ENTRY MUST BE BEFORE 10/1/96

 +3       ;;3;;ALREADY HAS A VISIT

 +4       ;;4;;ENTRY IS A 'CHILD'

 +5       ;;5;;ENTRY DOES NOT HAVE A VALID DISPOSITION

 +6       ;;6;;APPOINTMENT STATUS IS NOT VALID

 +7       ;;7;;APPOINTMENT IS NOT FOR A VALID CLINIC

 +8       ;;8;;ENTRY WAS NOT PREVIOUSLY CONVERTED

 +9       ;;9;;ENCOUNTER NOT CHECKED OUT

 +10      ;

SCCVCST4.m