- SDES2CRTVISIT ;ALB/JAS - SDES2 VISTA SCHEDULING API for creating Visits when necessary ;APR 25, 2024
- ;;5.3;Scheduling;**878**;Aug 13, 1993;Build 11
- ;;Per VHA Directive 6402, this routine should not be modified
- ;
- ; Based off of SDECALV & SDECALV1 with a portion of code pulled from SDECEKL
- ;
- EN1(SDVISITOUT,SDVISITIN) ;VISIT CREATION
- ;INPUT:
- ; SDVISITIN("SDDATE") .01 VISIT/ADMIT DATE&TIME in fm format
- ; $$NOW^XLFDT .02 DATE VISIT CREATED
- ; SDVISITIN("SDTYPE") .03 TYPE valid values:
- ; I:IHS,C:CONTRACT,T:TRIBAL,O:OTHER,6:638 PROGRAM,V:VA
- ; SDVISITIN("SDPAT") .05 Patient pointer to PATIENT file 2
- ; SDVISITIN("SDLOC") .06 LOC. OF ENCOUNTER pointer to LOCATION file
- ; SDVISITIN("SDCAT") .07 Service Category
- ; SDVISITIN("SDCLN") .08 DSS ID (Clinic Stop)
- ; SDVISITIN("SDPVL") .12 Parent Visit Link
- ; DT .13 Date Last Modified in fm format
- ; SDVISITIN("SDCODT") .18 Check out Date&Time
- ; SDVISITIN("SDVELG") .21 Eligibility pointer to ELIGIBILITY CODE file 8
- ; SDVISITIN("SDHL") .22 Hospital Location pointer to file 44
- ; SDVISITIN("SDUSR") .23 Created by user pointer to NEW PERSON
- ; SDVISITIN("SDOPT") .24 Option used to Create pointer to OPTION file
- ; SDVISITIN("SDPROT") .25 Protocol pointer to PROTOCOL file
- ; SDVISITIN("SDOLOC") 2101 outside location
- ;
- D VALVISIT(.SDVSTARRAY,.SDVISITIN)
- ;
- I $G(SDVSTARRAY("SDADD")) D GENVISIT(.SDVISITCRT,.SDVSTARRAY) ; forced add
- I $G(SDVISITCRT("SDVSIT")),$G(SDVISITCRT("SDCLN")),$$GET1^DIQ(9000010,SDVISITCRT("SDVSIT")_",",.08,"I")="" D
- . N SDFDA
- . S SDFDA(9000010,SDVISITCRT("SDVSIT")_",",.08)=SDVISITCRT("SDCLN")
- . D FILE^DIE("","SDFDA","SDERR")
- ;
- I $D(SDVISITCRT) D
- . S SDVISITOUT("SDPAT")=$G(SDVISITCRT("SDPAT"))
- . S SDVISITOUT("SDVSIT")=$G(SDVISITCRT("SDVSIT"))
- . S:$G(SDVISITCRT("NEW")) SDVISITOUT("NEW")=SDVISITCRT("NEW")
- . S:$G(SDVISITCRT("SDAFLG")) SDVISITOUT("SDAFLG")=SDVISITCRT("SDAFLG")
- D CLNUP
- Q
- ;
- GENVISIT(SDVISITCRT,SDVISITIN) ; GENERATE NEW VISIT
- ;
- N D0,DA,DIC,DIE,DR,X,Y,%DT
- N AUPNDOB,AUPNDOD,AUPNSEX
- N SDDOB,SDDOD,SDFDA,SDIEN,SDMSG,SDSEX,VID
- S Y=SDVISITIN("SDPAT") D ^AUPNPAT K Y
- S SDSEX=AUPNSEX,SDDOB=AUPNDOB,SDDOD=AUPNDOD
- S X=$G(SDVISITIN("SDDATE")),%DT="TRXN" D ^%DT S X=Y I X=-1 D Q
- . S SDVISITCRT("SDAFLG")=1,SDVISITCRT("SDERR")=".01^"_SDVISITIN("SDDATE")_"^DATE INVALID FOR PATIENT,CANNOT CREATE VISIT .01 VALUE"
- D VSIT01^AUPNVSIT
- I '$D(X) S SDVISITCRT("SDAFLG")=1,SDVISITCRT("SDERR")=".01^"_SDVISITIN("SDDATE")_"^DATE INVALID FOR PATIENT,CANNOT CREATE VISIT .01 VALUE" Q
- S SDFDA="SDFDA(9000010,""+1,"")"
- S @SDFDA@(.01)=$G(SDVISITIN("SDDATE"))
- S @SDFDA@(.02)=$$NOW^XLFDT
- S @SDFDA@(.03)=$G(SDVISITIN("SDTYPE"))
- S @SDFDA@(.05)=$G(SDVISITIN("SDPAT"))
- S @SDFDA@(.06)=$G(SDVISITIN("SDLOC"))
- S @SDFDA@(.07)=$G(SDVISITIN("SDCAT"))
- S @SDFDA@(.08)=$G(SDVISITIN("SDCLN"))
- S @SDFDA@(.12)=$G(SDVISITIN("SDPVL"))
- S @SDFDA@(.13)=DT
- S @SDFDA@(.18)=$G(SDVISITIN("SDCODT"))
- S @SDFDA@(.21)=$G(SDVISITIN("SDVELG"))
- S @SDFDA@(.22)=$G(SDVISITIN("SDHL"))
- S @SDFDA@(.23)=$G(SDVISITIN("SDUSR"))
- S @SDFDA@(.24)=$G(SDVISITIN("SDOPT"))
- S @SDFDA@(.25)=$G(SDVISITIN("SDPROT"))
- S @SDFDA@(2101)=$S($G(SDVISITIN("SDOLOC"))]"":SDVISITIN("SDOLOC"),1:"")
- S VID=$$GETVID^VSITVID S @SDFDA@(15001)=VID
- D UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
- ;
- I $D(SDMSG) S SDVISITCRT("SDAFLG")=1,SDVISITCRT("SDERR")=".01^"_SDVISITIN("CDT")_"^VISIT CREATION FAILED" Q
- S SDVISITCRT("SDVSIT")=+SDIEN(1)
- I $T(GETVID^VSITVID)]"",$$GET1^DIQ(150.9,"1,",402,"I")]"" D
- . S VID=$$GETVID^VSITVID
- . S DIE=9000010,DA=SDVISITCRT("SDVSIT"),DR="15001///"_VID
- . D ^DIE K VID,DIE,DR,DA
- S SDVISITCRT("NEW")=1
- Q
- ;
- VALVISIT(SDVSTARRAY,SDVISITIN) ;Validation for SDVISITIN variables
- ;
- S SDVSTARRAY("SDAPDT")=$G(SDVISITIN("APPT DATE"))
- S SDVSTARRAY("SDCAT")=$G(SDVISITIN("SDCAT"))
- S SDVSTARRAY("SDEVM")=$G(SDVISITIN("SDEVM"))
- S SDVSTARRAY("SDDATE")=$G(SDVISITIN("SDDATE"))
- S SDVSTARRAY("SDHL")=$G(SDVISITIN("SDHL"))
- S SDVSTARRAY("SDLOC")=$G(SDVISITIN("SDLOC"))
- S SDVSTARRAY("SDCODT")=$G(SDVISITIN("SDCODT"))
- S SDVSTARRAY("SDOLOC")=$G(SDVISITIN("SDOLOC"))
- S SDVSTARRAY("SDOPT")=$G(SDVISITIN("SDOPT"))
- S SDVSTARRAY("SDPAT")=$G(SDVISITIN("SDPAT"))
- S SDVSTARRAY("SDPROT")=$G(SDVISITIN("SDPROT"))
- S SDVSTARRAY("SDPVL")=$G(SDVISITIN("SDPVL"))
- S SDVSTARRAY("SDTPB")=$G(SDVISITIN("SDTPB"))
- S SDVSTARRAY("SDTYPE")=$G(SDVISITIN("SDTYPE"))
- S SDVSTARRAY("SDUSR")=$G(SDVISITIN("SDUSR"))
- S SDVSTARRAY("SDVELG")=$G(SDVISITIN("SDVELG"))
- S SDVSTARRAY("SDVSIT")=$G(SDVISITIN("SDVSIT"))
- S SDVSTARRAY("SDADD")=$G(SDVISITIN("SDADD"))
- ; EDIT PASSED-IN VARIABLES
- N DIC,X,Y
- S:$P(SDVSTARRAY("SDDATE"),".",2)="" SDVSTARRAY("SDDATE")=+SDVSTARRAY("SDDATE")_".12"
- S SDVSTARRAY("SDDATE")=$E(SDVSTARRAY("SDDATE"),1,12)
- S:'$D(SDVSTARRAY("SDTYPE")) SDVSTARRAY("SDTYPE")="I"
- I SDVSTARRAY("SDTYPE")="" S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".03^"_SDVSTARRAY("SDTYPE")_"^TYPE OF VISIT MISSING" Q
- S:$G(SDVSTARRAY("SDCAT"))="" SDVSTARRAY("SDCAT")="A"
- S:$E(SDVSTARRAY("SDPAT"))="`" SDVSTARRAY("SDPAT")=$E(SDVSTARRAY("SDPAT"),2,99)
- I '$D(^AUPNPAT(SDVSTARRAY("SDPAT"),0)) D Q
- . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".05^"_SDVSTARRAY("SDPAT")_"^PATIENT NOT IN AUPNPAT GLOBAL" Q
- S:$E(SDVSTARRAY("SDLOC"))="`" SDVSTARRAY("SDLOC")=$E(SDVSTARRAY("SDLOC"),2,99)
- I '$D(^AUTTLOC(SDVSTARRAY("SDLOC"),0)) S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".06^"_SDVSTARRAY("SDLOC")_"^LOCATION PTR NOT IN AUTTLOC" Q
- I $D(SDVSTARRAY("SDOLOC")),SDVSTARRAY("SDOLOC")?.E1C.E D Q
- . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")="2101^"_SDVSTARRAY("SDOLOC")_"^OUTSIDE LOCATION FAILED INPUT TX" Q
- I $G(SDVSTARRAY("SDOLOC"))]"",$L(SDVSTARRAY("SDOLOC"))<2!($L(SDVSTARRAY("SDOLOC"))>50) D Q
- . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")="2101^"_SDVSTARRAY("SDOLOC")_"^OUTSIDE LOCATION FAILED INPUT TX" Q
- I $D(SDVSTARRAY("SDCLN")),SDVSTARRAY("SDCLN")="" K SDVSTARRAY("SDCLN") Q
- Q:'$D(SDVSTARRAY("SDCLN"))
- S:$E(SDVSTARRAY("SDCLN"))="`" SDVSTARRAY("SDCLN")=$E(SDVSTARRAY("SDCLN"),2,99)
- I SDVSTARRAY("SDCLN")?1N.N,'$D(^DIC(40.7,SDVSTARRAY("SDCLN"),0)) D Q
- . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".08^"_SDVSTARRAY("SDCLN")_"^CLINIC NOT VALID" Q
- I SDVSTARRAY("SDCLN")'?1N.N S X=SDVSTARRAY("SDCLN"),DIC="^DIC(40.7,",DIC(0)="M" D ^DIC S:+Y>0 SDVSTARRAY("SDCLN")=+Y
- I SDVSTARRAY("SDCLN")'?1N.N S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".08^"_SDVSTARRAY("SDCLN")_"^CLINIC NOT VALID" Q
- I $D(SDVSTARRAY("SDTPB")) S X="`"_SDVSTARRAY("SDTPB") I '$D(X) D Q
- . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".04^"_SDVSTARRAY("SDTPB")_"^.04 VALUE MUST BE IN INTERNAL FORMAT AND PASS INPUT TX"
- ;
- I $D(SDVSTARRAY("SDPVL")),'$D(^AUPNVSIT(SDVSTARRAY("SDPVL")))!($P($G(^AUPNVSIT(SDVSTARRAY("SDPVL"),0)),U,11)) D Q
- . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".12^"_SDVSTARRAY("SDPVL")_"^MUST BE INTERNAL VALUE AND VALID VISIT PTR"
- ;
- I $G(SDVSTARRAY("SDEVM"))]"",'SDVSTARRAY("SDEVM") D Q
- . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".17^"_SDVSTARRAY("SDEVM")_"^EVAL&MAN NOT VALID INTERNAL FORMAT"
- ;
- I $G(SDVSTARRAY("SDCODT"))]"" S X=$$FMTE^XLFDT(SDVSTARRAY("SDCODT")) X $P(^DD(9000010,.18,0),U,5,99) I '$D(X) D Q
- . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".18^"_SDVSTARRAY("SDCODT")_"^CHECK OUT DATE/TIME FAILED INPUT TX"
- ;
- I $G(SDVSTARRAY("SDVELG"))]"",'SDVSTARRAY("SDVELG") D Q
- . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".21^"_SDVSTARRAY("SDVELG")_"^VA ELIG NOT VALID INTERNAL FORMAT"
- ;
- I $G(SDVSTARRAY("SDHL"))]"",'SDVSTARRAY("SDHL") D Q
- . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".22^"_SDVSTARRAY("SDHL")_"^HOSPITAL LOCATION NOT VALID INTERNAL FORMAT"
- ;
- I $G(SDVSTARRAY("SDOPT"))]"",'SDVSTARRAY("SDOPT") D Q
- . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".24^"_SDVSTARRAY("SDOPT")_"^OPTION USED TO CREATE NOT VALID INTERNAL FORMAT"
- Q
- ;
- I $G(SDVSTARRAY("SDPROT"))]"",'SDVSTARRAY("SDPROT") D Q
- . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".25^"_SDVSTARRAY("SDPROT")_"^PROTOCOL USED TO CREATE NOT VALID INTERNAL FORMAT"
- ;
- I SDVSTARRAY("SDAPDT")]"" S X=$$FMTE^XLFDT(SDVSTARRAY("SDAPDT")) X $P(^DD(9000010,.26,0),U,5,99) I '$D(X) D Q
- . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".26^"_SDVSTARRAY("SDAPDT")_"^APPT DATE/TIME FAILED INPUT TX - MUST BE IN INTERNAL FM FORMAT"
- Q
- ;
- CLNUP ;
- K AUPNPAT,AUPNDAYS,SDVISITIN,SDVISITCRT,SDVSTARRAY
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2CRTVISIT 8484 printed Feb 19, 2025@00:20:08 Page 2
- SDES2CRTVISIT ;ALB/JAS - SDES2 VISTA SCHEDULING API for creating Visits when necessary ;APR 25, 2024
- +1 ;;5.3;Scheduling;**878**;Aug 13, 1993;Build 11
- +2 ;;Per VHA Directive 6402, this routine should not be modified
- +3 ;
- +4 ; Based off of SDECALV & SDECALV1 with a portion of code pulled from SDECEKL
- +5 ;
- EN1(SDVISITOUT,SDVISITIN) ;VISIT CREATION
- +1 ;INPUT:
- +2 ; SDVISITIN("SDDATE") .01 VISIT/ADMIT DATE&TIME in fm format
- +3 ; $$NOW^XLFDT .02 DATE VISIT CREATED
- +4 ; SDVISITIN("SDTYPE") .03 TYPE valid values:
- +5 ; I:IHS,C:CONTRACT,T:TRIBAL,O:OTHER,6:638 PROGRAM,V:VA
- +6 ; SDVISITIN("SDPAT") .05 Patient pointer to PATIENT file 2
- +7 ; SDVISITIN("SDLOC") .06 LOC. OF ENCOUNTER pointer to LOCATION file
- +8 ; SDVISITIN("SDCAT") .07 Service Category
- +9 ; SDVISITIN("SDCLN") .08 DSS ID (Clinic Stop)
- +10 ; SDVISITIN("SDPVL") .12 Parent Visit Link
- +11 ; DT .13 Date Last Modified in fm format
- +12 ; SDVISITIN("SDCODT") .18 Check out Date&Time
- +13 ; SDVISITIN("SDVELG") .21 Eligibility pointer to ELIGIBILITY CODE file 8
- +14 ; SDVISITIN("SDHL") .22 Hospital Location pointer to file 44
- +15 ; SDVISITIN("SDUSR") .23 Created by user pointer to NEW PERSON
- +16 ; SDVISITIN("SDOPT") .24 Option used to Create pointer to OPTION file
- +17 ; SDVISITIN("SDPROT") .25 Protocol pointer to PROTOCOL file
- +18 ; SDVISITIN("SDOLOC") 2101 outside location
- +19 ;
- +20 DO VALVISIT(.SDVSTARRAY,.SDVISITIN)
- +21 ;
- +22 ; forced add
- IF $GET(SDVSTARRAY("SDADD"))
- DO GENVISIT(.SDVISITCRT,.SDVSTARRAY)
- +23 IF $GET(SDVISITCRT("SDVSIT"))
- IF $GET(SDVISITCRT("SDCLN"))
- IF $$GET1^DIQ(9000010,SDVISITCRT("SDVSIT")_",",.08,"I")=""
- Begin DoDot:1
- +24 NEW SDFDA
- +25 SET SDFDA(9000010,SDVISITCRT("SDVSIT")_",",.08)=SDVISITCRT("SDCLN")
- +26 DO FILE^DIE("","SDFDA","SDERR")
- End DoDot:1
- +27 ;
- +28 IF $DATA(SDVISITCRT)
- Begin DoDot:1
- +29 SET SDVISITOUT("SDPAT")=$GET(SDVISITCRT("SDPAT"))
- +30 SET SDVISITOUT("SDVSIT")=$GET(SDVISITCRT("SDVSIT"))
- +31 if $GET(SDVISITCRT("NEW"))
- SET SDVISITOUT("NEW")=SDVISITCRT("NEW")
- +32 if $GET(SDVISITCRT("SDAFLG"))
- SET SDVISITOUT("SDAFLG")=SDVISITCRT("SDAFLG")
- End DoDot:1
- +33 DO CLNUP
- +34 QUIT
- +35 ;
- GENVISIT(SDVISITCRT,SDVISITIN) ; GENERATE NEW VISIT
- +1 ;
- +2 NEW D0,DA,DIC,DIE,DR,X,Y,%DT
- +3 NEW AUPNDOB,AUPNDOD,AUPNSEX
- +4 NEW SDDOB,SDDOD,SDFDA,SDIEN,SDMSG,SDSEX,VID
- +5 SET Y=SDVISITIN("SDPAT")
- DO ^AUPNPAT
- KILL Y
- +6 SET SDSEX=AUPNSEX
- SET SDDOB=AUPNDOB
- SET SDDOD=AUPNDOD
- +7 SET X=$GET(SDVISITIN("SDDATE"))
- SET %DT="TRXN"
- DO ^%DT
- SET X=Y
- IF X=-1
- Begin DoDot:1
- +8 SET SDVISITCRT("SDAFLG")=1
- SET SDVISITCRT("SDERR")=".01^"_SDVISITIN("SDDATE")_"^DATE INVALID FOR PATIENT,CANNOT CREATE VISIT .01 VALUE"
- End DoDot:1
- QUIT
- +9 DO VSIT01^AUPNVSIT
- +10 IF '$DATA(X)
- SET SDVISITCRT("SDAFLG")=1
- SET SDVISITCRT("SDERR")=".01^"_SDVISITIN("SDDATE")_"^DATE INVALID FOR PATIENT,CANNOT CREATE VISIT .01 VALUE"
- QUIT
- +11 SET SDFDA="SDFDA(9000010,""+1,"")"
- +12 SET @SDFDA@(.01)=$GET(SDVISITIN("SDDATE"))
- +13 SET @SDFDA@(.02)=$$NOW^XLFDT
- +14 SET @SDFDA@(.03)=$GET(SDVISITIN("SDTYPE"))
- +15 SET @SDFDA@(.05)=$GET(SDVISITIN("SDPAT"))
- +16 SET @SDFDA@(.06)=$GET(SDVISITIN("SDLOC"))
- +17 SET @SDFDA@(.07)=$GET(SDVISITIN("SDCAT"))
- +18 SET @SDFDA@(.08)=$GET(SDVISITIN("SDCLN"))
- +19 SET @SDFDA@(.12)=$GET(SDVISITIN("SDPVL"))
- +20 SET @SDFDA@(.13)=DT
- +21 SET @SDFDA@(.18)=$GET(SDVISITIN("SDCODT"))
- +22 SET @SDFDA@(.21)=$GET(SDVISITIN("SDVELG"))
- +23 SET @SDFDA@(.22)=$GET(SDVISITIN("SDHL"))
- +24 SET @SDFDA@(.23)=$GET(SDVISITIN("SDUSR"))
- +25 SET @SDFDA@(.24)=$GET(SDVISITIN("SDOPT"))
- +26 SET @SDFDA@(.25)=$GET(SDVISITIN("SDPROT"))
- +27 SET @SDFDA@(2101)=$SELECT($GET(SDVISITIN("SDOLOC"))]"":SDVISITIN("SDOLOC"),1:"")
- +28 SET VID=$$GETVID^VSITVID
- SET @SDFDA@(15001)=VID
- +29 DO UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
- +30 ;
- +31 IF $DATA(SDMSG)
- SET SDVISITCRT("SDAFLG")=1
- SET SDVISITCRT("SDERR")=".01^"_SDVISITIN("CDT")_"^VISIT CREATION FAILED"
- QUIT
- +32 SET SDVISITCRT("SDVSIT")=+SDIEN(1)
- +33 IF $TEXT(GETVID^VSITVID)]""
- IF $$GET1^DIQ(150.9,"1,",402,"I")]""
- Begin DoDot:1
- +34 SET VID=$$GETVID^VSITVID
- +35 SET DIE=9000010
- SET DA=SDVISITCRT("SDVSIT")
- SET DR="15001///"_VID
- +36 DO ^DIE
- KILL VID,DIE,DR,DA
- End DoDot:1
- +37 SET SDVISITCRT("NEW")=1
- +38 QUIT
- +39 ;
- VALVISIT(SDVSTARRAY,SDVISITIN) ;Validation for SDVISITIN variables
- +1 ;
- +2 SET SDVSTARRAY("SDAPDT")=$GET(SDVISITIN("APPT DATE"))
- +3 SET SDVSTARRAY("SDCAT")=$GET(SDVISITIN("SDCAT"))
- +4 SET SDVSTARRAY("SDEVM")=$GET(SDVISITIN("SDEVM"))
- +5 SET SDVSTARRAY("SDDATE")=$GET(SDVISITIN("SDDATE"))
- +6 SET SDVSTARRAY("SDHL")=$GET(SDVISITIN("SDHL"))
- +7 SET SDVSTARRAY("SDLOC")=$GET(SDVISITIN("SDLOC"))
- +8 SET SDVSTARRAY("SDCODT")=$GET(SDVISITIN("SDCODT"))
- +9 SET SDVSTARRAY("SDOLOC")=$GET(SDVISITIN("SDOLOC"))
- +10 SET SDVSTARRAY("SDOPT")=$GET(SDVISITIN("SDOPT"))
- +11 SET SDVSTARRAY("SDPAT")=$GET(SDVISITIN("SDPAT"))
- +12 SET SDVSTARRAY("SDPROT")=$GET(SDVISITIN("SDPROT"))
- +13 SET SDVSTARRAY("SDPVL")=$GET(SDVISITIN("SDPVL"))
- +14 SET SDVSTARRAY("SDTPB")=$GET(SDVISITIN("SDTPB"))
- +15 SET SDVSTARRAY("SDTYPE")=$GET(SDVISITIN("SDTYPE"))
- +16 SET SDVSTARRAY("SDUSR")=$GET(SDVISITIN("SDUSR"))
- +17 SET SDVSTARRAY("SDVELG")=$GET(SDVISITIN("SDVELG"))
- +18 SET SDVSTARRAY("SDVSIT")=$GET(SDVISITIN("SDVSIT"))
- +19 SET SDVSTARRAY("SDADD")=$GET(SDVISITIN("SDADD"))
- +20 ; EDIT PASSED-IN VARIABLES
- +21 NEW DIC,X,Y
- +22 if $PIECE(SDVSTARRAY("SDDATE"),".",2)=""
- SET SDVSTARRAY("SDDATE")=+SDVSTARRAY("SDDATE")_".12"
- +23 SET SDVSTARRAY("SDDATE")=$EXTRACT(SDVSTARRAY("SDDATE"),1,12)
- +24 if '$DATA(SDVSTARRAY("SDTYPE"))
- SET SDVSTARRAY("SDTYPE")="I"
- +25 IF SDVSTARRAY("SDTYPE")=""
- SET SDVSTARRAY("SDAFLG")=1
- SET SDVSTARRAY("SDERR")=".03^"_SDVSTARRAY("SDTYPE")_"^TYPE OF VISIT MISSING"
- QUIT
- +26 if $GET(SDVSTARRAY("SDCAT"))=""
- SET SDVSTARRAY("SDCAT")="A"
- +27 if $EXTRACT(SDVSTARRAY("SDPAT"))="`"
- SET SDVSTARRAY("SDPAT")=$EXTRACT(SDVSTARRAY("SDPAT"),2,99)
- +28 IF '$DATA(^AUPNPAT(SDVSTARRAY("SDPAT"),0))
- Begin DoDot:1
- +29 SET SDVSTARRAY("SDAFLG")=1
- SET SDVSTARRAY("SDERR")=".05^"_SDVSTARRAY("SDPAT")_"^PATIENT NOT IN AUPNPAT GLOBAL"
- QUIT
- End DoDot:1
- QUIT
- +30 if $EXTRACT(SDVSTARRAY("SDLOC"))="`"
- SET SDVSTARRAY("SDLOC")=$EXTRACT(SDVSTARRAY("SDLOC"),2,99)
- +31 IF '$DATA(^AUTTLOC(SDVSTARRAY("SDLOC"),0))
- SET SDVSTARRAY("SDAFLG")=1
- SET SDVSTARRAY("SDERR")=".06^"_SDVSTARRAY("SDLOC")_"^LOCATION PTR NOT IN AUTTLOC"
- QUIT
- +32 IF $DATA(SDVSTARRAY("SDOLOC"))
- IF SDVSTARRAY("SDOLOC")?.E1C.E
- Begin DoDot:1
- +33 SET SDVSTARRAY("SDAFLG")=1
- SET SDVSTARRAY("SDERR")="2101^"_SDVSTARRAY("SDOLOC")_"^OUTSIDE LOCATION FAILED INPUT TX"
- QUIT
- End DoDot:1
- QUIT
- +34 IF $GET(SDVSTARRAY("SDOLOC"))]""
- IF $LENGTH(SDVSTARRAY("SDOLOC"))<2!($LENGTH(SDVSTARRAY("SDOLOC"))>50)
- Begin DoDot:1
- +35 SET SDVSTARRAY("SDAFLG")=1
- SET SDVSTARRAY("SDERR")="2101^"_SDVSTARRAY("SDOLOC")_"^OUTSIDE LOCATION FAILED INPUT TX"
- QUIT
- End DoDot:1
- QUIT
- +36 IF $DATA(SDVSTARRAY("SDCLN"))
- IF SDVSTARRAY("SDCLN")=""
- KILL SDVSTARRAY("SDCLN")
- QUIT
- +37 if '$DATA(SDVSTARRAY("SDCLN"))
- QUIT
- +38 if $EXTRACT(SDVSTARRAY("SDCLN"))="`"
- SET SDVSTARRAY("SDCLN")=$EXTRACT(SDVSTARRAY("SDCLN"),2,99)
- +39 IF SDVSTARRAY("SDCLN")?1N.N
- IF '$DATA(^DIC(40.7,SDVSTARRAY("SDCLN"),0))
- Begin DoDot:1
- +40 SET SDVSTARRAY("SDAFLG")=1
- SET SDVSTARRAY("SDERR")=".08^"_SDVSTARRAY("SDCLN")_"^CLINIC NOT VALID"
- QUIT
- End DoDot:1
- QUIT
- +41 IF SDVSTARRAY("SDCLN")'?1N.N
- SET X=SDVSTARRAY("SDCLN")
- SET DIC="^DIC(40.7,"
- SET DIC(0)="M"
- DO ^DIC
- if +Y>0
- SET SDVSTARRAY("SDCLN")=+Y
- +42 IF SDVSTARRAY("SDCLN")'?1N.N
- SET SDVSTARRAY("SDAFLG")=1
- SET SDVSTARRAY("SDERR")=".08^"_SDVSTARRAY("SDCLN")_"^CLINIC NOT VALID"
- QUIT
- +43 IF $DATA(SDVSTARRAY("SDTPB"))
- SET X="`"_SDVSTARRAY("SDTPB")
- IF '$DATA(X)
- Begin DoDot:1
- +44 SET SDVSTARRAY("SDAFLG")=1
- SET SDVSTARRAY("SDERR")=".04^"_SDVSTARRAY("SDTPB")_"^.04 VALUE MUST BE IN INTERNAL FORMAT AND PASS INPUT TX"
- End DoDot:1
- QUIT
- +45 ;
- +46 IF $DATA(SDVSTARRAY("SDPVL"))
- IF '$DATA(^AUPNVSIT(SDVSTARRAY("SDPVL")))!($PIECE($GET(^AUPNVSIT(SDVSTARRAY("SDPVL"),0)),U,11))
- Begin DoDot:1
- +47 SET SDVSTARRAY("SDAFLG")=1
- SET SDVSTARRAY("SDERR")=".12^"_SDVSTARRAY("SDPVL")_"^MUST BE INTERNAL VALUE AND VALID VISIT PTR"
- End DoDot:1
- QUIT
- +48 ;
- +49 IF $GET(SDVSTARRAY("SDEVM"))]""
- IF 'SDVSTARRAY("SDEVM")
- Begin DoDot:1
- +50 SET SDVSTARRAY("SDAFLG")=1
- SET SDVSTARRAY("SDERR")=".17^"_SDVSTARRAY("SDEVM")_"^EVAL&MAN NOT VALID INTERNAL FORMAT"
- End DoDot:1
- QUIT
- +51 ;
- +52 IF $GET(SDVSTARRAY("SDCODT"))]""
- SET X=$$FMTE^XLFDT(SDVSTARRAY("SDCODT"))
- XECUTE $PIECE(^DD(9000010,.18,0),U,5,99)
- IF '$DATA(X)
- Begin DoDot:1
- +53 SET SDVSTARRAY("SDAFLG")=1
- SET SDVSTARRAY("SDERR")=".18^"_SDVSTARRAY("SDCODT")_"^CHECK OUT DATE/TIME FAILED INPUT TX"
- End DoDot:1
- QUIT
- +54 ;
- +55 IF $GET(SDVSTARRAY("SDVELG"))]""
- IF 'SDVSTARRAY("SDVELG")
- Begin DoDot:1
- +56 SET SDVSTARRAY("SDAFLG")=1
- SET SDVSTARRAY("SDERR")=".21^"_SDVSTARRAY("SDVELG")_"^VA ELIG NOT VALID INTERNAL FORMAT"
- End DoDot:1
- QUIT
- +57 ;
- +58 IF $GET(SDVSTARRAY("SDHL"))]""
- IF 'SDVSTARRAY("SDHL")
- Begin DoDot:1
- +59 SET SDVSTARRAY("SDAFLG")=1
- SET SDVSTARRAY("SDERR")=".22^"_SDVSTARRAY("SDHL")_"^HOSPITAL LOCATION NOT VALID INTERNAL FORMAT"
- End DoDot:1
- QUIT
- +60 ;
- +61 IF $GET(SDVSTARRAY("SDOPT"))]""
- IF 'SDVSTARRAY("SDOPT")
- Begin DoDot:1
- +62 SET SDVSTARRAY("SDAFLG")=1
- SET SDVSTARRAY("SDERR")=".24^"_SDVSTARRAY("SDOPT")_"^OPTION USED TO CREATE NOT VALID INTERNAL FORMAT"
- End DoDot:1
- QUIT
- +63 QUIT
- +64 ;
- +65 IF $GET(SDVSTARRAY("SDPROT"))]""
- IF 'SDVSTARRAY("SDPROT")
- Begin DoDot:1
- +66 SET SDVSTARRAY("SDAFLG")=1
- SET SDVSTARRAY("SDERR")=".25^"_SDVSTARRAY("SDPROT")_"^PROTOCOL USED TO CREATE NOT VALID INTERNAL FORMAT"
- End DoDot:1
- QUIT
- +67 ;
- +68 IF SDVSTARRAY("SDAPDT")]""
- SET X=$$FMTE^XLFDT(SDVSTARRAY("SDAPDT"))
- XECUTE $PIECE(^DD(9000010,.26,0),U,5,99)
- IF '$DATA(X)
- Begin DoDot:1
- +69 SET SDVSTARRAY("SDAFLG")=1
- SET SDVSTARRAY("SDERR")=".26^"_SDVSTARRAY("SDAPDT")_"^APPT DATE/TIME FAILED INPUT TX - MUST BE IN INTERNAL FM FORMAT"
- End DoDot:1
- QUIT
- +70 QUIT
- +71 ;
- CLNUP ;
- +1 KILL AUPNPAT,AUPNDAYS,SDVISITIN,SDVISITCRT,SDVSTARRAY
- +2 QUIT