SCCVCST3 ;ALB/TMP - Scheduling Conversion Template Utilities - CST; APR 20, 1998
;;5.3;Scheduling;**211**;Aug 13, 1993
;
ONE ; -- Select/Convert one pt's encounter episode - no CST needed
D FULL^VALM1
; -- is conversion enabled
IF '$$OK^SCCVU(1) G ONEQ
;
F W !! Q:$$SEL1()
;
ONEQ S VALMBCK="R"
Q
;
SEL1() ; Select an entry, convert
N DIR,X,Y,SCFILE,SCFILE1,SCCVDFN,SCCVTYP,SCCVDA,SCCVCOD,SCQUIT,DA,DIC,DIQ,SCSTOP,SCCVEVT,SCPREF,Z,SCCVACRP,SCCV900,SCCVDIS
S SCCVACRP=$$ENDDATE^SCCVU()
S SCCV900=+$O(^DIC(40.7,"C",900,0))
S SCSTOP=0
S DIR(0)="SAMB^C:Convert;R:Reconvert",DIR("A")="(C)onvert/(R)econvert: ",DIR("B")="Convert"
D ^DIR K DIR
I Y["^" S SCSTOP=1 G SEL1Q
S SCCVEVT=$S(Y="C":1,1:2),SCPREF=$S(SCCVEVT=1:"",1:"re")
;
S DIR(0)="SABM^E:Encounter;D:Disposition;A:Appointment;S:Standalone Add/Edit",SCCVCOD=$P(DIR(0),U,2)
S DIR("A")="TYPE OF ENTRY TO "_$S(SCCVEVT=1:"",1:"RE")_"CONVERT: ",DIR("?")="Select the type of entry you want to "_SCPREF_"convert from the list"
D ^DIR K DIR
I "EDAS"'[Y S SCSTOP=1 G SEL1Q
S SCCVTYP=Y,SCCVTYPN=$P($P(SCCVCOD,SCCVTYP_":",2),";")
;
S DIC="^DPT(",DIC(0)="AEMQ" D ^DIC ;Select patient
G:Y'>0 SEL1Q
S SCCVDFN=+Y
;
S SCFILE=$$SETFL($S(SCCVTYP="E":0,SCCVTYP="D":3,SCCVTYP="A":1,1:2),SCCVDFN)
S SCFILE1=$S(SCFILE["SCE"!(SCFILE["SDV"):SCFILE_"("_$S(SCFILE["SCE":"""ADFN"","_SCCVDFN_",",1:""),1:$P(SCFILE,")")_",") ;Indirection format
;
; Select a specific entry
S SCQUIT=0
W !
S DIR(0)=$S(SCFILE["SCE":"NAO^^I $P($G(^SCE(X,0)),U,2)'=SCCVDFN K X",SCFILE["SDV":"FAO^^D DTCNVT^SCCVCST3(.X)",1:"DAO^:"_SCCVACRP_":RXP")
S DIR("A")="ENTER THE "_$S(SCFILE["SDV":"SCHEDULING VISIT ENTRY #",SCFILE["SCE":"ENCOUNTER ENTRY #",SCFILE["""DIS""":"DISPOSITION DATE/TIME",1:"APPOINTMENT DATE/TIME")_", IF KNOWN: "
S DIR("?",1)="Enter the "_$S(SCFILE["SCE":"internal entry number",1:"date/time")_" of the "_SCCVTYPN_" to "_SCPREF_"convert, if you know it"
S Z=2
I SCFILE["SDV" S DIR("?",2)="Date may be entered in internal or external format",Z=Z+1
S DIR("?",Z)="Must be a valid "_SCCVTYPN_$S(SCFILE'["SCE":" date/time",1:"")_" for the patient"_$S(SCFILE'["SCE":", on or before "_$$FMTE^XLFDT(SCCVACRP,"1D"),1:"")
S DIR("?")="If not known, Press RETURN to review the "_SCCVTYPN_"s on a specific date"
D ^DIR K DIR
W !!
;
S SCCVDA=$S(Y'>0:0,SCFILE'["""DIS""":+Y,1:9999999-Y)
I SCCVDA D CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,$S(SCFILE'["SCE":+Y,1:+$G(^SCE(SCCVDA,0))),SCCVDA,0,.SCQUIT,.SCONE) ;Specific entry selected
;
G:SCQUIT SEL1Q
;
; Select entry by date or date/time
S DIR(0)="DAO^:"_SCCVACRP_":PTSX"
S DIR("A")="DATE: "
S DIR("?",1)="Enter a valid date or date and time of the patient's "_SCCVTYPN_" to "_SCPREF_"convert."
S DIR("?",2)=" The date must be on or before "_$$FMTE^XLFDT(SCCVACRP,1)_".",DIR("?",3)=" "
S DIR("?",4)="If you enter only a date, all the patient's "_SCCVTYPN_"s on that date will be",DIR("?",5)=" presented one at a time. If the entry displayed is the correct one,"
S DIR("?")=" you may request it be "_SCPREF_"converted or if not the correct one, reject it."
D ^DIR K DIR
G:'Y SEL1Q
S SCDTM=+Y,SCQUIT=0
;
I SCDTM'["." D G:SCQUIT SEL1Q ; Date only entered
. ; SCQUIT is set to 1 when an entry is selected for conversion
. ; SCONE is set to 1 if at least one valid entry is found
. ;
. N SCONE,SC,SCV,SCF,SCD
. S SCF=$S(SCFILE["SCE":"^SCE(""ADFN"","_SCCVDFN_")",SCFILE["SDV":"^SDV(""ADT"","_SCCVDFN_")",1:SCFILE)
. S SCONE=$S(SCF["SCE":$O(@SCF@(SCDTM)),SCF["""S""":$O(@SCF@(SCDTM)),SCF["""DIS""":9999999-$O(@SCF@(9999999-SCDTM),-1),1:$O(@SCF@(SCDTM-1)))
. S SCONE=(SCONE\1=SCDTM)
. I '$G(SCONE) D NOENT^SCCVCST4(SCCVTYPN,SCCVDFN,SCDTM) S SCQUIT=1 Q ;No valid entry found
. I SCCVEVT=2 S SCONE=0
. ;
. I SCFILE["SCE"!(SCFILE["""S""") D ; Encounters and Appts
.. S SC=SCDTM,SCONE=0
.. F S SC=$O(@SCF@(SC)) Q:'SC!((SC\1)'=SCDTM) D Q:SCQUIT
... I SCF["SCE" D ; Encounters
.... S SCD=0 F S SCD=$O(@SCF@(SC,SCD)) Q:'SCD W "." I '$P($G(^SCE(SCD,0)),U,6) D CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,+$G(^SCE(SCD,0)),SCD,1,.SCQUIT,.SCONE) Q:SCQUIT
... ;
... I SCF["""S""" D ; Appts
.... D CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,SC,SC,1,.SCQUIT,.SCONE)
. ;
. I SCFILE["""DIS""" D ; Dispositions
.. S SCDTM=9999999-SCDTM-1,SC=SCDTM+1,SCONE=0
.. F S SC=$O(@SCF@(SC),-1) Q:'SC!((SC\1)'=SCDTM) W "." D Q:SCQUIT
... D CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,9999999-SC,SC,1,.SCQUIT,.SCONE)
. I SCFILE["SDV" D ; Add/edits
.. S SCONE=0,SC=$G(@SCF@(SCDTM))
.. Q:SC=""
.. D CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,SC,SC,1,.SCQUIT,.SCONE)
. ;
. I 'SCONE S SCQUIT=1 D NOENT^SCCVCST4(SCCVTYPN,SCCVDFN,SCDTM) Q
. ;
. I 'SCQUIT,SCONE S DIR(0)="EA",DIR("A",1)="NO ENTRY SELECTED",DIR("A")="PRESS RETURN " D ^DIR K DIR
;
I SCDTM["." D ; Date and time entered
. I SCFILE["SCE" D ; Encounter
.. S SCCVDA=0 F S SCCVDA=$O(^SCE("ADFN",SCCVDFN,SCDTM,SCCVDA)) W "." Q:'SCCVDA D
... D CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,SCDTM,SCCVDA,1,.SCQUIT,.SCONE)
. ;
. I SCFILE'["SCE" D ; Non-encounter
.. S SCCVDA=$S(SCFILE'["""DIS""":SCDTM,1:9999999-SCDTM)
.. D CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,SCDTM,SCCVDA,0,.SCQUIT,.SCONE)
SEL1Q Q SCSTOP
;
SETFL(SCCVTYP,SCCVDFN) ;Set the lookup format of the file
; INPUT: SCCVTYP, SCCVDFN
; FUNCTION OUTPUT: Lookup format of filename for type/patient
;
Q $S(SCCVTYP=0:"^SCE",SCCVTYP=3:"^DPT("_SCCVDFN_",""DIS"")",SCCVTYP=1:"^DPT("_SCCVDFN_",""S"")",SCCVTYP=2:"^SDV",1:"")
;
CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,SCDTM,SC,SCMULT,SCQUIT,SCONE) ;
; Check for validity for convert, display entry, convert if confirmed
N SCV,DIR,Y
I $$VAL1^SCCVCST5(SCCVEVT,SCFILE,SC,SCMULT) D
.S SCONE=1
.W ! S SCV=$$DISP1^SCCVCST4(SCCVTYPN,SCFILE1,SC)
.I 'SCV S:SCV="^" SCQUIT=1 Q
.S SCQUIT=1 D CONV1^SCCVCST4(SCCVEVT,SCFILE,SCCVDFN,SCDTM,SC)
Q
;
DTCNVT(X) ; Convert date/time for disposition
N SCZ,SCX,Y,Z,%DT
S %DT="RXPT"
I X["@"!(X'[".") D
. S SCX=$P(X,"@",2)
. S SCZ=$TR(SCX,"APMapm"),Z=$L(SCZ) ;strip AM/PM from time
. I Z>4 S %DT=%DT_"S" S:Z=5 X=$P(X,"@")_"@"_SCZ_"0"
D ^%DT S X=Y
K:Y<0 X
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCCVCST3 6183 printed Oct 16, 2024@18:39:08 Page 2
SCCVCST3 ;ALB/TMP - Scheduling Conversion Template Utilities - CST; APR 20, 1998
+1 ;;5.3;Scheduling;**211**;Aug 13, 1993
+2 ;
ONE ; -- Select/Convert one pt's encounter episode - no CST needed
+1 DO FULL^VALM1
+2 ; -- is conversion enabled
+3 IF '$$OK^SCCVU(1)
GOTO ONEQ
+4 ;
+5 FOR
WRITE !!
if $$SEL1()
QUIT
+6 ;
ONEQ SET VALMBCK="R"
+1 QUIT
+2 ;
SEL1() ; Select an entry, convert
+1 NEW DIR,X,Y,SCFILE,SCFILE1,SCCVDFN,SCCVTYP,SCCVDA,SCCVCOD,SCQUIT,DA,DIC,DIQ,SCSTOP,SCCVEVT,SCPREF,Z,SCCVACRP,SCCV900,SCCVDIS
+2 SET SCCVACRP=$$ENDDATE^SCCVU()
+3 SET SCCV900=+$ORDER(^DIC(40.7,"C",900,0))
+4 SET SCSTOP=0
+5 SET DIR(0)="SAMB^C:Convert;R:Reconvert"
SET DIR("A")="(C)onvert/(R)econvert: "
SET DIR("B")="Convert"
+6 DO ^DIR
KILL DIR
+7 IF Y["^"
SET SCSTOP=1
GOTO SEL1Q
+8 SET SCCVEVT=$SELECT(Y="C":1,1:2)
SET SCPREF=$SELECT(SCCVEVT=1:"",1:"re")
+9 ;
+10 SET DIR(0)="SABM^E:Encounter;D:Disposition;A:Appointment;S:Standalone Add/Edit"
SET SCCVCOD=$PIECE(DIR(0),U,2)
+11 SET DIR("A")="TYPE OF ENTRY TO "_$SELECT(SCCVEVT=1:"",1:"RE")_"CONVERT: "
SET DIR("?")="Select the type of entry you want to "_SCPREF_"convert from the list"
+12 DO ^DIR
KILL DIR
+13 IF "EDAS"'[Y
SET SCSTOP=1
GOTO SEL1Q
+14 SET SCCVTYP=Y
SET SCCVTYPN=$PIECE($PIECE(SCCVCOD,SCCVTYP_":",2),";")
+15 ;
+16 ;Select patient
SET DIC="^DPT("
SET DIC(0)="AEMQ"
DO ^DIC
+17 if Y'>0
GOTO SEL1Q
+18 SET SCCVDFN=+Y
+19 ;
+20 SET SCFILE=$$SETFL($SELECT(SCCVTYP="E":0,SCCVTYP="D":3,SCCVTYP="A":1,1:2),SCCVDFN)
+21 ;Indirection format
SET SCFILE1=$SELECT(SCFILE["SCE"!(SCFILE["SDV"):SCFILE_"("_$SELECT(SCFILE["SCE":"""ADFN"","_SCCVDFN_",",1:""),1:$PIECE(SCFILE,")")_",")
+22 ;
+23 ; Select a specific entry
+24 SET SCQUIT=0
+25 WRITE !
+26 SET DIR(0)=$SELECT(SCFILE["SCE":"NAO^^I $P($G(^SCE(X,0)),U,2)'=SCCVDFN K X",SCFILE["SDV":"FAO^^D DTCNVT^SCCVCST3(.X)",1:"DAO^:"_SCCVACRP_":RXP")
+27 SET DIR("A")="ENTER THE "_$SELECT(SCFILE["SDV":"SCHEDULING VISIT ENTRY #",SCFILE["SCE":"ENCOUNTER ENTRY #",SCFILE["""DIS""":"DISPOSITION DATE/TIME",1:"APPOINTMENT DATE/TIME")_", IF KNOWN: "
+28 SET DIR("?",1)="Enter the "_$SELECT(SCFILE["SCE":"internal entry number",1:"date/time")_" of the "_SCCVTYPN_" to "_SCPREF_"convert, if you know it"
+29 SET Z=2
+30 IF SCFILE["SDV"
SET DIR("?",2)="Date may be entered in internal or external format"
SET Z=Z+1
+31 SET DIR("?",Z)="Must be a valid "_SCCVTYPN_$SELECT(SCFILE'["SCE":" date/time",1:"")_" for the patient"_$SELECT(SCFILE'["SCE":", on or before "_$$FMTE^XLFDT(SCCVACRP,"1D"),1:"")
+32 SET DIR("?")="If not known, Press RETURN to review the "_SCCVTYPN_"s on a specific date"
+33 DO ^DIR
KILL DIR
+34 WRITE !!
+35 ;
+36 SET SCCVDA=$SELECT(Y'>0:0,SCFILE'["""DIS""":+Y,1:9999999-Y)
+37 ;Specific entry selected
IF SCCVDA
DO CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,$SELECT(SCFILE'["SCE":+Y,1:+$GET(^SCE(SCCVDA,0))),SCCVDA,0,.SCQUIT,.SCONE)
+38 ;
+39 if SCQUIT
GOTO SEL1Q
+40 ;
+41 ; Select entry by date or date/time
+42 SET DIR(0)="DAO^:"_SCCVACRP_":PTSX"
+43 SET DIR("A")="DATE: "
+44 SET DIR("?",1)="Enter a valid date or date and time of the patient's "_SCCVTYPN_" to "_SCPREF_"convert."
+45 SET DIR("?",2)=" The date must be on or before "_$$FMTE^XLFDT(SCCVACRP,1)_"."
SET DIR("?",3)=" "
+46 SET DIR("?",4)="If you enter only a date, all the patient's "_SCCVTYPN_"s on that date will be"
SET DIR("?",5)=" presented one at a time. If the entry displayed is the correct one,"
+47 SET DIR("?")=" you may request it be "_SCPREF_"converted or if not the correct one, reject it."
+48 DO ^DIR
KILL DIR
+49 if 'Y
GOTO SEL1Q
+50 SET SCDTM=+Y
SET SCQUIT=0
+51 ;
+52 ; Date only entered
IF SCDTM'["."
Begin DoDot:1
+53 ; SCQUIT is set to 1 when an entry is selected for conversion
+54 ; SCONE is set to 1 if at least one valid entry is found
+55 ;
+56 NEW SCONE,SC,SCV,SCF,SCD
+57 SET SCF=$SELECT(SCFILE["SCE":"^SCE(""ADFN"","_SCCVDFN_")",SCFILE["SDV":"^SDV(""ADT"","_SCCVDFN_")",1:SCFILE)
+58 SET SCONE=$SELECT(SCF["SCE":$ORDER(@SCF@(SCDTM)),SCF["""S""":$ORDER(@SCF@(SCDTM)),SCF["""DIS""":9999999-$ORDER(@SCF@(9999999-SCDTM),-1),1:$ORDER(@SCF@(SCDTM-1)))
+59 SET SCONE=(SCONE\1=SCDTM)
+60 ;No valid entry found
IF '$GET(SCONE)
DO NOENT^SCCVCST4(SCCVTYPN,SCCVDFN,SCDTM)
SET SCQUIT=1
QUIT
+61 IF SCCVEVT=2
SET SCONE=0
+62 ;
+63 ; Encounters and Appts
IF SCFILE["SCE"!(SCFILE["""S""")
Begin DoDot:2
+64 SET SC=SCDTM
SET SCONE=0
+65 FOR
SET SC=$ORDER(@SCF@(SC))
if 'SC!((SC\1)'=SCDTM)
QUIT
Begin DoDot:3
+66 ; Encounters
IF SCF["SCE"
Begin DoDot:4
+67 SET SCD=0
FOR
SET SCD=$ORDER(@SCF@(SC,SCD))
if 'SCD
QUIT
WRITE "."
IF '$PIECE($GET(^SCE(SCD,0)),U,6)
DO CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,+$GET(^SCE(SCD,0)),SCD,1,.SCQUIT,.SCONE)
if SCQUIT
QUIT
End DoDot:4
+68 ;
+69 ; Appts
IF SCF["""S"""
Begin DoDot:4
+70 DO CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,SC,SC,1,.SCQUIT,.SCONE)
End DoDot:4
End DoDot:3
if SCQUIT
QUIT
End DoDot:2
+71 ;
+72 ; Dispositions
IF SCFILE["""DIS"""
Begin DoDot:2
+73 SET SCDTM=9999999-SCDTM-1
SET SC=SCDTM+1
SET SCONE=0
+74 FOR
SET SC=$ORDER(@SCF@(SC),-1)
if 'SC!((SC\1)'=SCDTM)
QUIT
WRITE "."
Begin DoDot:3
+75 DO CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,9999999-SC,SC,1,.SCQUIT,.SCONE)
End DoDot:3
if SCQUIT
QUIT
End DoDot:2
+76 ; Add/edits
IF SCFILE["SDV"
Begin DoDot:2
+77 SET SCONE=0
SET SC=$GET(@SCF@(SCDTM))
+78 if SC=""
QUIT
+79 DO CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,SC,SC,1,.SCQUIT,.SCONE)
End DoDot:2
+80 ;
+81 IF 'SCONE
SET SCQUIT=1
DO NOENT^SCCVCST4(SCCVTYPN,SCCVDFN,SCDTM)
QUIT
+82 ;
+83 IF 'SCQUIT
IF SCONE
SET DIR(0)="EA"
SET DIR("A",1)="NO ENTRY SELECTED"
SET DIR("A")="PRESS RETURN "
DO ^DIR
KILL DIR
End DoDot:1
if SCQUIT
GOTO SEL1Q
+84 ;
+85 ; Date and time entered
IF SCDTM["."
Begin DoDot:1
+86 ; Encounter
IF SCFILE["SCE"
Begin DoDot:2
+87 SET SCCVDA=0
FOR
SET SCCVDA=$ORDER(^SCE("ADFN",SCCVDFN,SCDTM,SCCVDA))
WRITE "."
if 'SCCVDA
QUIT
Begin DoDot:3
+88 DO CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,SCDTM,SCCVDA,1,.SCQUIT,.SCONE)
End DoDot:3
End DoDot:2
+89 ;
+90 ; Non-encounter
IF SCFILE'["SCE"
Begin DoDot:2
+91 SET SCCVDA=$SELECT(SCFILE'["""DIS""":SCDTM,1:9999999-SCDTM)
+92 DO CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,SCDTM,SCCVDA,0,.SCQUIT,.SCONE)
End DoDot:2
End DoDot:1
SEL1Q QUIT SCSTOP
+1 ;
SETFL(SCCVTYP,SCCVDFN) ;Set the lookup format of the file
+1 ; INPUT: SCCVTYP, SCCVDFN
+2 ; FUNCTION OUTPUT: Lookup format of filename for type/patient
+3 ;
+4 QUIT $SELECT(SCCVTYP=0:"^SCE",SCCVTYP=3:"^DPT("_SCCVDFN_",""DIS"")",SCCVTYP=1:"^DPT("_SCCVDFN_",""S"")",SCCVTYP=2:"^SDV",1:"")
+5 ;
CHK(SCCVEVT,SCCVTYPN,SCFILE,SCFILE1,SCDTM,SC,SCMULT,SCQUIT,SCONE) ;
+1 ; Check for validity for convert, display entry, convert if confirmed
+2 NEW SCV,DIR,Y
+3 IF $$VAL1^SCCVCST5(SCCVEVT,SCFILE,SC,SCMULT)
Begin DoDot:1
+4 SET SCONE=1
+5 WRITE !
SET SCV=$$DISP1^SCCVCST4(SCCVTYPN,SCFILE1,SC)
+6 IF 'SCV
if SCV="^"
SET SCQUIT=1
QUIT
+7 SET SCQUIT=1
DO CONV1^SCCVCST4(SCCVEVT,SCFILE,SCCVDFN,SCDTM,SC)
End DoDot:1
+8 QUIT
+9 ;
DTCNVT(X) ; Convert date/time for disposition
+1 NEW SCZ,SCX,Y,Z,%DT
+2 SET %DT="RXPT"
+3 IF X["@"!(X'[".")
Begin DoDot:1
+4 SET SCX=$PIECE(X,"@",2)
+5 ;strip AM/PM from time
SET SCZ=$TRANSLATE(SCX,"APMapm")
SET Z=$LENGTH(SCZ)
+6 IF Z>4
SET %DT=%DT_"S"
if Z=5
SET X=$PIECE(X,"@")_"@"_SCZ_"0"
End DoDot:1
+7 DO ^%DT
SET X=Y
+8 if Y<0
KILL X
+9 QUIT
+10 ;
