Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDECALV1

SDECALV1.m

Go to the documentation of this file.
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