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.
  1. SDECALV1 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
  1. ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
  1. ;
  1. Q
  1. ;
  1. INIT(SDALVR) ;EP;INITIALIZATION/EDIT INPUT VARIABLES
  1. ;required
  1. ; SDDATE
  1. ; SDLOC
  1. ; SDPAT
  1. ;optional
  1. ; SDAC
  1. ; SDALV
  1. ; SDALVR
  1. ; SDAPDT
  1. ; SDCAT
  1. ; SDCODT
  1. ; SDEVM
  1. ; SDHL
  1. ; SDOLOC
  1. ; SDOPT
  1. ; SDPROT
  1. ; SDPVL
  1. ; SDTBP
  1. ; SDTYPE
  1. ; SDVELG
  1. ; SDVSIT
  1. N SDAL,SDAX
  1. N SDAPDT,SDCAT,SDEVM,SDCODT,SDDATE,SDHL,SDLOC,SDOLOC,SDOPT,SDPAT,SDPROT,SDPVL
  1. N SDTPB,SDTYPE,SDUSR,SDVELG,SDVSIT
  1. S SDAPDT=$G(SDALVR("APPT DATE"))
  1. S SDCAT=$G(SDALVR("SDCAT"))
  1. S SDEVM=$G(SDALVR("SDEVM"))
  1. S SDDATE=$G(SDALVR("SDDATE"))
  1. S SDHL=$G(SDALVR("SDHL"))
  1. S SDLOC=$G(SDALVR("SDLOC"))
  1. S SDCODT=$G(SDALVR("SDCODT"))
  1. S SDOLOC=$G(SDALVR("SDOLOC"))
  1. S SDOPT=$G(SDALVR("SDOPT"))
  1. S SDPAT=$G(SDALVR("SDPAT"))
  1. S SDPROT=$G(SDALVR("SDPROT"))
  1. S SDPVL=$G(SDALVR("SDPVL"))
  1. S SDTPB=$G(SDALVR("SDTPB"))
  1. S SDTYPE=$G(SDALVR("SDTYPE"))
  1. S SDUSR=$G(SDALVR("SDUSR"))
  1. S SDVELG=$G(SDALVR("SDVELG"))
  1. S SDVSIT=$G(SDALVR("SDVSIT"))
  1. S SDVSIT("NEW")=$G(SDALVR("SDVSIT","NEW"))
  1. K SDAFLG,SDALVR("SDAFLG"),SDVSIT("NEW"),SDALVR("SDVSIT","NEW")
  1. I $D(SDALVR)\10 S SDAX="" F SDAL=0:0 S SDAX=$O(SDALVR(SDAX)) Q:SDAX="" S @SDAX=SDALVR(SDAX)
  1. S U="^",SDVSIT=""
  1. D EDIT
  1. Q:$D(SDAFLG)
  1. Q
  1. ;
  1. EDIT ; EDIT PASSED VARIABLES
  1. N DIC,X,Y
  1. I $D(SDADF),SDADF=+SDADF,SDADF>0,SDADF<4
  1. E K SDADF ; kill it if it isn't right
  1. S:$P(SDDATE,".",2)="" SDDATE=+SDDATE_".12"
  1. S SDDATE=$E(SDDATE,1,12)
  1. S:'$D(SDTYPE) SDTYPE="I"
  1. I SDTYPE="" S SDAFLG=3,SDAFLG("ERR")=".03^"_SDTYPE_"^TYPE OF VISIT MISSING" Q
  1. S:'$D(SDCAT) SDCAT="A"
  1. S:SDCAT="" SDCAT="A"
  1. S:$E(SDPAT)="`" SDPAT=$E(SDPAT,2,99)
  1. I '$D(^AUPNPAT(SDPAT,0)) S SDAFLG=3,SDAFLG("ERR")=".05^"_SDPAT_"^PATIENT NOT IN AUPNPAT GLOBAL" Q
  1. S:$E(SDLOC)="`" SDLOC=$E(SDLOC,2,99)
  1. I '$D(^AUTTLOC(SDLOC,0)) S SDAFLG=3,SDAFLG("ERR")=".06^"_SDLOC_"^LOCATION PTR NOT IN AUTTLOC" Q
  1. I $D(SDOLOC),SDOLOC?.E1C.E S SDAFLG=3,SDAFLG("ERR")="2101^"_SDOLOC_"^OUTSIDE LOCATION FAILED INPUT TX" Q
  1. I $G(SDOLOC)]"",$L(SDOLOC)<2!($L(SDOLOC)>50) S SDAFLG=3,SDAFLG("ERR")="2101^"_SDOLOC_"^OUTSIDE LOCATION FAILED INPUT TX" Q
  1. I $D(SDCLN),SDCLN="" K SDCLN Q
  1. Q:'$D(SDCLN)
  1. S:$E(SDCLN)="`" SDCLN=$E(SDCLN,2,99)
  1. I SDCLN?1N.N,'$D(^DIC(40.7,SDCLN,0)) S SDAFLG=3,SDAFLG("ERR")=".08^"_SDCLN_"^CLINIC NOT VALID" Q
  1. I SDCLN'?1N.N S X=SDCLN,DIC="^DIC(40.7,",DIC(0)="M" D ^DIC S:+Y>0 SDCLN=+Y
  1. I SDCLN'?1N.N S SDAFLG=3,SDAFLG("ERR")=".08^"_SDCLN_"^CLINIC NOT VALID" Q
  1. 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
  1. 12 ;
  1. 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
  1. 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
  1. 17 ;
  1. I $G(SDEVM)]"",'SDEVM S SDAFLG=3,SDAFLG("ERR")=".17^"_SDEVM_"^EVAL&MAN NOT VALID INTERNAL FORMAT" Q
  1. ;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
  1. 18 ;
  1. 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
  1. 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
  1. 21 ;
  1. I $G(SDVELG)]"",'SDVELG S SDAFLG=3,SDAFLG("ERR")=".21^"_SDVELG_"^VA ELIG NOT VALID INTERNAL FORMAT" Q
  1. ;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
  1. 22 ;
  1. I $G(SDHL)]"",'SDHL S SDAFLG=3,SDAFLG("ERR")=".22^"_SDHL_"^HOSPITAL LOCATION NOT VALID INTERNAL FORMAT" Q
  1. ;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
  1. 24 ;
  1. I $G(SDOPT)]"",'SDOPT S SDAFLG=3,SDAFLG("ERR")=".24^"_SDOPT_"^OPTION USED TO CREATE NOT VALID INTERNAL FORMAT" Q
  1. ;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
  1. Q
  1. 25 ;
  1. I $G(SDPROT)]"",'SDPROT S SDAFLG=3,SDAFLG("ERR")=".25^"_SDPROT_"^PROTOCOL USED TO CREATE NOT VALID INTERNAL FORMAT" Q
  1. ;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
  1. 26 ;
  1. 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
  1. Q