SDECALV1 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
;
Q
;
INIT(SDALVR) ;EP;INITIALIZATION/EDIT INPUT VARIABLES
;required
; SDDATE
; SDLOC
; SDPAT
;optional
; SDAC
; SDALV
; SDALVR
; SDAPDT
; SDCAT
; SDCODT
; SDEVM
; SDHL
; SDOLOC
; SDOPT
; SDPROT
; SDPVL
; SDTBP
; SDTYPE
; SDVELG
; SDVSIT
N SDAL,SDAX
N SDAPDT,SDCAT,SDEVM,SDCODT,SDDATE,SDHL,SDLOC,SDOLOC,SDOPT,SDPAT,SDPROT,SDPVL
N SDTPB,SDTYPE,SDUSR,SDVELG,SDVSIT
S SDAPDT=$G(SDALVR("APPT DATE"))
S SDCAT=$G(SDALVR("SDCAT"))
S SDEVM=$G(SDALVR("SDEVM"))
S SDDATE=$G(SDALVR("SDDATE"))
S SDHL=$G(SDALVR("SDHL"))
S SDLOC=$G(SDALVR("SDLOC"))
S SDCODT=$G(SDALVR("SDCODT"))
S SDOLOC=$G(SDALVR("SDOLOC"))
S SDOPT=$G(SDALVR("SDOPT"))
S SDPAT=$G(SDALVR("SDPAT"))
S SDPROT=$G(SDALVR("SDPROT"))
S SDPVL=$G(SDALVR("SDPVL"))
S SDTPB=$G(SDALVR("SDTPB"))
S SDTYPE=$G(SDALVR("SDTYPE"))
S SDUSR=$G(SDALVR("SDUSR"))
S SDVELG=$G(SDALVR("SDVELG"))
S SDVSIT=$G(SDALVR("SDVSIT"))
S SDVSIT("NEW")=$G(SDALVR("SDVSIT","NEW"))
K SDAFLG,SDALVR("SDAFLG"),SDVSIT("NEW"),SDALVR("SDVSIT","NEW")
I $D(SDALVR)\10 S SDAX="" F SDAL=0:0 S SDAX=$O(SDALVR(SDAX)) Q:SDAX="" S @SDAX=SDALVR(SDAX)
S U="^",SDVSIT=""
D EDIT
Q:$D(SDAFLG)
Q
;
EDIT ; EDIT PASSED VARIABLES
N DIC,X,Y
I $D(SDADF),SDADF=+SDADF,SDADF>0,SDADF<4
E K SDADF ; kill it if it isn't right
S:$P(SDDATE,".",2)="" SDDATE=+SDDATE_".12"
S SDDATE=$E(SDDATE,1,12)
S:'$D(SDTYPE) SDTYPE="I"
I SDTYPE="" S SDAFLG=3,SDAFLG("ERR")=".03^"_SDTYPE_"^TYPE OF VISIT MISSING" Q
S:'$D(SDCAT) SDCAT="A"
S:SDCAT="" SDCAT="A"
S:$E(SDPAT)="`" SDPAT=$E(SDPAT,2,99)
I '$D(^AUPNPAT(SDPAT,0)) S SDAFLG=3,SDAFLG("ERR")=".05^"_SDPAT_"^PATIENT NOT IN AUPNPAT GLOBAL" Q
S:$E(SDLOC)="`" SDLOC=$E(SDLOC,2,99)
I '$D(^AUTTLOC(SDLOC,0)) S SDAFLG=3,SDAFLG("ERR")=".06^"_SDLOC_"^LOCATION PTR NOT IN AUTTLOC" Q
I $D(SDOLOC),SDOLOC?.E1C.E S SDAFLG=3,SDAFLG("ERR")="2101^"_SDOLOC_"^OUTSIDE LOCATION FAILED INPUT TX" Q
I $G(SDOLOC)]"",$L(SDOLOC)<2!($L(SDOLOC)>50) S SDAFLG=3,SDAFLG("ERR")="2101^"_SDOLOC_"^OUTSIDE LOCATION FAILED INPUT TX" Q
I $D(SDCLN),SDCLN="" K SDCLN Q
Q:'$D(SDCLN)
S:$E(SDCLN)="`" SDCLN=$E(SDCLN,2,99)
I SDCLN?1N.N,'$D(^DIC(40.7,SDCLN,0)) S SDAFLG=3,SDAFLG("ERR")=".08^"_SDCLN_"^CLINIC NOT VALID" Q
I SDCLN'?1N.N S X=SDCLN,DIC="^DIC(40.7,",DIC(0)="M" D ^DIC S:+Y>0 SDCLN=+Y
I SDCLN'?1N.N S SDAFLG=3,SDAFLG("ERR")=".08^"_SDCLN_"^CLINIC NOT VALID" Q
I $D(SDTPB) S X="`"_SDTPB I '$D(X) S SDAFLG=3,SDAFLG("ERR")=".04^"_SDTPB_"^.04 VALUE MUST BE IN INTERNAL FORMAT AND PASS INPUT TX" Q
12 ;
I $D(SDPVL),'$D(^AUPNVSIT(SDPVL))!($P($G(^AUPNVSIT(SDPVL,0)),U,11)) S SDAFLG=3,SDAFLG("ERR")=".12^"_SDPVL_"^MUST BE INTERNAL VALUE AND VALID VISIT PTR" Q
16 ;
;I $G(SDAPPT)]"" S %=$$EXTSET^XBFUNC(9000010,.16,SDAPPT) I %="" S SDAFLG=3,SDAFLG("ERR")=".16^"_SDAPPT_"^WALKIN / APPT FAILED INPUT TX" Q
17 ;
I $G(SDEVM)]"",'SDEVM S SDAFLG=3,SDAFLG("ERR")=".17^"_SDEVM_"^EVAL&MAN NOT VALID INTERNAL FORMAT" Q
;I $G(SDEVM) S %=$P($G(^DD(9000010,.17,12.1)),"=",2) S X=$$FIND1^SDDIC(81,SDEVM,"I",%) I 'X S SDAFLG=3,SDAFLG("ERR")=".17^"_SDEVM_"^EVAL&MAN FAILED INPUT TX" Q
18 ;
I $G(SDCODT)]"" S X=$$FMTE^XLFDT(SDCODT) X $P(^DD(9000010,.18,0),U,5,99) I '$D(X) S SDAFLG=3,SDAFLG("ERR")=".18^"_SDCODT_"^CHECK OUT DATE/TIME FAILED INPUT TX" Q
19 ;
;I $G(SDLS)]"" S %=$$EXTSET^XBFUNC(9000010,.19,SDLS) I %="" S SDAFLG=3,SDAFLG("ERR")=".19^"_SDLS_"^LEVEL OF SERVICE FAILED INPUT TX" Q
21 ;
I $G(SDVELG)]"",'SDVELG S SDAFLG=3,SDAFLG("ERR")=".21^"_SDVELG_"^VA ELIG NOT VALID INTERNAL FORMAT" Q
;I $G(SDVELG) S %=$P($G(^DD(9000010,.21,12.1)),"=",2) S X=$$FIND1^SDDIC(8,SDVELG,"I",%) I 'X S SDAFLG=3,SDAFLG("ERR")=".21^"_SDVELG_"^VA ELIG FAILED INPUT TX" Q
22 ;
I $G(SDHL)]"",'SDHL S SDAFLG=3,SDAFLG("ERR")=".22^"_SDHL_"^HOSPITAL LOCATION NOT VALID INTERNAL FORMAT" Q
;I $G(SDHL) S %=$P($G(^DD(9000010,.22,12.1)),"=",2) S X=$$FIND1^SDDIC(44,SDHL,"I",%) I 'X S SDAFLG=3,SDAFLG("ERR")=".22^"_SDHL_"^HOSPITAL LOCATION FAILED INPUT TX" Q
24 ;
I $G(SDOPT)]"",'SDOPT S SDAFLG=3,SDAFLG("ERR")=".24^"_SDOPT_"^OPTION USED TO CREATE NOT VALID INTERNAL FORMAT" Q
;I $G(SDOPT) S %=$P($G(^DD(9000010,.24,12.1)),"=",2) S X=$$FIND1^SDDIC(19,SDOPT,"I",%) I 'X S SDAFLG=3,SDAFLG("ERR")=".24^"_SDOPT_"^OPTION USED TO CREATE FAILED INPUT TX" Q
Q
25 ;
I $G(SDPROT)]"",'SDPROT S SDAFLG=3,SDAFLG("ERR")=".25^"_SDPROT_"^PROTOCOL USED TO CREATE NOT VALID INTERNAL FORMAT" Q
;I $G(SDPROT) S %=$P($G(^DD(9000010,.25,12.1)),"=",2) S X=$$FIND1^SDDIC(101,SDPROT,"I",%) I 'X S SDAFLG=3,SDAFLG("ERR")=".25^"_SDPROT_"^PROTOCOL USED TO CREATE FAILED INPUT TX" Q
26 ;
I $G(SDAPDT)]"" S X=$$FMTE^XLFDT(SDAPDT) X $P(^DD(9000010,.26,0),U,5,99) I '$D(X) S SDAFLG=3,SDAFLG("ERR")=".26^"_SDAPDT_"^APPT DATE/TIME FAILED INPUT TX - MUST BE IN INTERNAL FM FORMAT" Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECALV1 4905 printed Dec 13, 2024@02:51:37 Page 2
SDECALV1 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
+1 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
+2 ;
+3 QUIT
+4 ;
INIT(SDALVR) ;EP;INITIALIZATION/EDIT INPUT VARIABLES
+1 ;required
+2 ; SDDATE
+3 ; SDLOC
+4 ; SDPAT
+5 ;optional
+6 ; SDAC
+7 ; SDALV
+8 ; SDALVR
+9 ; SDAPDT
+10 ; SDCAT
+11 ; SDCODT
+12 ; SDEVM
+13 ; SDHL
+14 ; SDOLOC
+15 ; SDOPT
+16 ; SDPROT
+17 ; SDPVL
+18 ; SDTBP
+19 ; SDTYPE
+20 ; SDVELG
+21 ; SDVSIT
+22 NEW SDAL,SDAX
+23 NEW SDAPDT,SDCAT,SDEVM,SDCODT,SDDATE,SDHL,SDLOC,SDOLOC,SDOPT,SDPAT,SDPROT,SDPVL
+24 NEW SDTPB,SDTYPE,SDUSR,SDVELG,SDVSIT
+25 SET SDAPDT=$GET(SDALVR("APPT DATE"))
+26 SET SDCAT=$GET(SDALVR("SDCAT"))
+27 SET SDEVM=$GET(SDALVR("SDEVM"))
+28 SET SDDATE=$GET(SDALVR("SDDATE"))
+29 SET SDHL=$GET(SDALVR("SDHL"))
+30 SET SDLOC=$GET(SDALVR("SDLOC"))
+31 SET SDCODT=$GET(SDALVR("SDCODT"))
+32 SET SDOLOC=$GET(SDALVR("SDOLOC"))
+33 SET SDOPT=$GET(SDALVR("SDOPT"))
+34 SET SDPAT=$GET(SDALVR("SDPAT"))
+35 SET SDPROT=$GET(SDALVR("SDPROT"))
+36 SET SDPVL=$GET(SDALVR("SDPVL"))
+37 SET SDTPB=$GET(SDALVR("SDTPB"))
+38 SET SDTYPE=$GET(SDALVR("SDTYPE"))
+39 SET SDUSR=$GET(SDALVR("SDUSR"))
+40 SET SDVELG=$GET(SDALVR("SDVELG"))
+41 SET SDVSIT=$GET(SDALVR("SDVSIT"))
+42 SET SDVSIT("NEW")=$GET(SDALVR("SDVSIT","NEW"))
+43 KILL SDAFLG,SDALVR("SDAFLG"),SDVSIT("NEW"),SDALVR("SDVSIT","NEW")
+44 IF $DATA(SDALVR)\10
SET SDAX=""
FOR SDAL=0:0
SET SDAX=$ORDER(SDALVR(SDAX))
if SDAX=""
QUIT
SET @SDAX=SDALVR(SDAX)
+45 SET U="^"
SET SDVSIT=""
+46 DO EDIT
+47 if $DATA(SDAFLG)
QUIT
+48 QUIT
+49 ;
EDIT ; EDIT PASSED VARIABLES
+1 NEW DIC,X,Y
+2 IF $DATA(SDADF)
IF SDADF=+SDADF
IF SDADF>0
IF SDADF<4
+3 ; kill it if it isn't right
IF '$TEST
KILL SDADF
+4 if $PIECE(SDDATE,".",2)=""
SET SDDATE=+SDDATE_".12"
+5 SET SDDATE=$EXTRACT(SDDATE,1,12)
+6 if '$DATA(SDTYPE)
SET SDTYPE="I"
+7 IF SDTYPE=""
SET SDAFLG=3
SET SDAFLG("ERR")=".03^"_SDTYPE_"^TYPE OF VISIT MISSING"
QUIT
+8 if '$DATA(SDCAT)
SET SDCAT="A"
+9 if SDCAT=""
SET SDCAT="A"
+10 if $EXTRACT(SDPAT)="`"
SET SDPAT=$EXTRACT(SDPAT,2,99)
+11 IF '$DATA(^AUPNPAT(SDPAT,0))
SET SDAFLG=3
SET SDAFLG("ERR")=".05^"_SDPAT_"^PATIENT NOT IN AUPNPAT GLOBAL"
QUIT
+12 if $EXTRACT(SDLOC)="`"
SET SDLOC=$EXTRACT(SDLOC,2,99)
+13 IF '$DATA(^AUTTLOC(SDLOC,0))
SET SDAFLG=3
SET SDAFLG("ERR")=".06^"_SDLOC_"^LOCATION PTR NOT IN AUTTLOC"
QUIT
+14 IF $DATA(SDOLOC)
IF SDOLOC?.E1C.E
SET SDAFLG=3
SET SDAFLG("ERR")="2101^"_SDOLOC_"^OUTSIDE LOCATION FAILED INPUT TX"
QUIT
+15 IF $GET(SDOLOC)]""
IF $LENGTH(SDOLOC)<2!($LENGTH(SDOLOC)>50)
SET SDAFLG=3
SET SDAFLG("ERR")="2101^"_SDOLOC_"^OUTSIDE LOCATION FAILED INPUT TX"
QUIT
+16 IF $DATA(SDCLN)
IF SDCLN=""
KILL SDCLN
QUIT
+17 if '$DATA(SDCLN)
QUIT
+18 if $EXTRACT(SDCLN)="`"
SET SDCLN=$EXTRACT(SDCLN,2,99)
+19 IF SDCLN?1N.N
IF '$DATA(^DIC(40.7,SDCLN,0))
SET SDAFLG=3
SET SDAFLG("ERR")=".08^"_SDCLN_"^CLINIC NOT VALID"
QUIT
+20 IF SDCLN'?1N.N
SET X=SDCLN
SET DIC="^DIC(40.7,"
SET DIC(0)="M"
DO ^DIC
if +Y>0
SET SDCLN=+Y
+21 IF SDCLN'?1N.N
SET SDAFLG=3
SET SDAFLG("ERR")=".08^"_SDCLN_"^CLINIC NOT VALID"
QUIT
+22 IF $DATA(SDTPB)
SET X="`"_SDTPB
IF '$DATA(X)
SET SDAFLG=3
SET SDAFLG("ERR")=".04^"_SDTPB_"^.04 VALUE MUST BE IN INTERNAL FORMAT AND PASS INPUT TX"
QUIT
12 ;
+1 IF $DATA(SDPVL)
IF '$DATA(^AUPNVSIT(SDPVL))!($PIECE($GET(^AUPNVSIT(SDPVL,0)),U,11))
SET SDAFLG=3
SET SDAFLG("ERR")=".12^"_SDPVL_"^MUST BE INTERNAL VALUE AND VALID VISIT PTR"
QUIT
16 ;
+1 ;I $G(SDAPPT)]"" S %=$$EXTSET^XBFUNC(9000010,.16,SDAPPT) I %="" S SDAFLG=3,SDAFLG("ERR")=".16^"_SDAPPT_"^WALKIN / APPT FAILED INPUT TX" Q
17 ;
+1 IF $GET(SDEVM)]""
IF 'SDEVM
SET SDAFLG=3
SET SDAFLG("ERR")=".17^"_SDEVM_"^EVAL&MAN NOT VALID INTERNAL FORMAT"
QUIT
+2 ;I $G(SDEVM) S %=$P($G(^DD(9000010,.17,12.1)),"=",2) S X=$$FIND1^SDDIC(81,SDEVM,"I",%) I 'X S SDAFLG=3,SDAFLG("ERR")=".17^"_SDEVM_"^EVAL&MAN FAILED INPUT TX" Q
18 ;
+1 IF $GET(SDCODT)]""
SET X=$$FMTE^XLFDT(SDCODT)
XECUTE $PIECE(^DD(9000010,.18,0),U,5,99)
IF '$DATA(X)
SET SDAFLG=3
SET SDAFLG("ERR")=".18^"_SDCODT_"^CHECK OUT DATE/TIME FAILED INPUT TX"
QUIT
19 ;
+1 ;I $G(SDLS)]"" S %=$$EXTSET^XBFUNC(9000010,.19,SDLS) I %="" S SDAFLG=3,SDAFLG("ERR")=".19^"_SDLS_"^LEVEL OF SERVICE FAILED INPUT TX" Q
21 ;
+1 IF $GET(SDVELG)]""
IF 'SDVELG
SET SDAFLG=3
SET SDAFLG("ERR")=".21^"_SDVELG_"^VA ELIG NOT VALID INTERNAL FORMAT"
QUIT
+2 ;I $G(SDVELG) S %=$P($G(^DD(9000010,.21,12.1)),"=",2) S X=$$FIND1^SDDIC(8,SDVELG,"I",%) I 'X S SDAFLG=3,SDAFLG("ERR")=".21^"_SDVELG_"^VA ELIG FAILED INPUT TX" Q
22 ;
+1 IF $GET(SDHL)]""
IF 'SDHL
SET SDAFLG=3
SET SDAFLG("ERR")=".22^"_SDHL_"^HOSPITAL LOCATION NOT VALID INTERNAL FORMAT"
QUIT
+2 ;I $G(SDHL) S %=$P($G(^DD(9000010,.22,12.1)),"=",2) S X=$$FIND1^SDDIC(44,SDHL,"I",%) I 'X S SDAFLG=3,SDAFLG("ERR")=".22^"_SDHL_"^HOSPITAL LOCATION FAILED INPUT TX" Q
24 ;
+1 IF $GET(SDOPT)]""
IF 'SDOPT
SET SDAFLG=3
SET SDAFLG("ERR")=".24^"_SDOPT_"^OPTION USED TO CREATE NOT VALID INTERNAL FORMAT"
QUIT
+2 ;I $G(SDOPT) S %=$P($G(^DD(9000010,.24,12.1)),"=",2) S X=$$FIND1^SDDIC(19,SDOPT,"I",%) I 'X S SDAFLG=3,SDAFLG("ERR")=".24^"_SDOPT_"^OPTION USED TO CREATE FAILED INPUT TX" Q
+3 QUIT
25 ;
+1 IF $GET(SDPROT)]""
IF 'SDPROT
SET SDAFLG=3
SET SDAFLG("ERR")=".25^"_SDPROT_"^PROTOCOL USED TO CREATE NOT VALID INTERNAL FORMAT"
QUIT
+2 ;I $G(SDPROT) S %=$P($G(^DD(9000010,.25,12.1)),"=",2) S X=$$FIND1^SDDIC(101,SDPROT,"I",%) I 'X S SDAFLG=3,SDAFLG("ERR")=".25^"_SDPROT_"^PROTOCOL USED TO CREATE FAILED INPUT TX" Q
26 ;
+1 IF $GET(SDAPDT)]""
SET X=$$FMTE^XLFDT(SDAPDT)
XECUTE $PIECE(^DD(9000010,.26,0),U,5,99)
IF '$DATA(X)
SET SDAFLG=3
SET SDAFLG("ERR")=".26^"_SDAPDT_"^APPT DATE/TIME FAILED INPUT TX - MUST BE IN INTERNAL FM FORMAT"
QUIT
+2 QUIT
