- 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 Feb 19, 2025@00:18:03 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