SCCVCST4 ;ALB/TMP - Scheduling Conversion Template Utilities - CST; APR 20, 1998
;;5.3;Scheduling;**211,1015**;Aug 13, 1993;Build 21
;
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
Q
;
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
Q
;
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 !
Q
;
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
;
SCCVCST4 ;ALB/TMP - Scheduling Conversion Template Utilities - CST; APR 20, 1998
+1 ;;5.3;Scheduling;**211,1015**;Aug 13, 1993;Build 21
+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 ;
