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

SDES2CRTVISIT.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 6402, this routine should not be modified
  1. ;
  1. ; Based off of SDECALV & SDECALV1 with a portion of code pulled from SDECEKL
  1. ;
  1. EN1(SDVISITOUT,SDVISITIN) ;VISIT CREATION
  1. ;INPUT:
  1. ; SDVISITIN("SDDATE") .01 VISIT/ADMIT DATE&TIME in fm format
  1. ; $$NOW^XLFDT .02 DATE VISIT CREATED
  1. ; SDVISITIN("SDTYPE") .03 TYPE valid values:
  1. ; I:IHS,C:CONTRACT,T:TRIBAL,O:OTHER,6:638 PROGRAM,V:VA
  1. ; SDVISITIN("SDPAT") .05 Patient pointer to PATIENT file 2
  1. ; SDVISITIN("SDLOC") .06 LOC. OF ENCOUNTER pointer to LOCATION file
  1. ; SDVISITIN("SDCAT") .07 Service Category
  1. ; SDVISITIN("SDCLN") .08 DSS ID (Clinic Stop)
  1. ; SDVISITIN("SDPVL") .12 Parent Visit Link
  1. ; DT .13 Date Last Modified in fm format
  1. ; SDVISITIN("SDCODT") .18 Check out Date&Time
  1. ; SDVISITIN("SDVELG") .21 Eligibility pointer to ELIGIBILITY CODE file 8
  1. ; SDVISITIN("SDHL") .22 Hospital Location pointer to file 44
  1. ; SDVISITIN("SDUSR") .23 Created by user pointer to NEW PERSON
  1. ; SDVISITIN("SDOPT") .24 Option used to Create pointer to OPTION file
  1. ; SDVISITIN("SDPROT") .25 Protocol pointer to PROTOCOL file
  1. ; SDVISITIN("SDOLOC") 2101 outside location
  1. ;
  1. D VALVISIT(.SDVSTARRAY,.SDVISITIN)
  1. ;
  1. I $G(SDVSTARRAY("SDADD")) D GENVISIT(.SDVISITCRT,.SDVSTARRAY) ; forced add
  1. I $G(SDVISITCRT("SDVSIT")),$G(SDVISITCRT("SDCLN")),$$GET1^DIQ(9000010,SDVISITCRT("SDVSIT")_",",.08,"I")="" D
  1. . N SDFDA
  1. . S SDFDA(9000010,SDVISITCRT("SDVSIT")_",",.08)=SDVISITCRT("SDCLN")
  1. . D FILE^DIE("","SDFDA","SDERR")
  1. ;
  1. I $D(SDVISITCRT) D
  1. . S SDVISITOUT("SDPAT")=$G(SDVISITCRT("SDPAT"))
  1. . S SDVISITOUT("SDVSIT")=$G(SDVISITCRT("SDVSIT"))
  1. . S:$G(SDVISITCRT("NEW")) SDVISITOUT("NEW")=SDVISITCRT("NEW")
  1. . S:$G(SDVISITCRT("SDAFLG")) SDVISITOUT("SDAFLG")=SDVISITCRT("SDAFLG")
  1. D CLNUP
  1. Q
  1. ;
  1. GENVISIT(SDVISITCRT,SDVISITIN) ; GENERATE NEW VISIT
  1. ;
  1. N D0,DA,DIC,DIE,DR,X,Y,%DT
  1. N AUPNDOB,AUPNDOD,AUPNSEX
  1. N SDDOB,SDDOD,SDFDA,SDIEN,SDMSG,SDSEX,VID
  1. S Y=SDVISITIN("SDPAT") D ^AUPNPAT K Y
  1. S SDSEX=AUPNSEX,SDDOB=AUPNDOB,SDDOD=AUPNDOD
  1. S X=$G(SDVISITIN("SDDATE")),%DT="TRXN" D ^%DT S X=Y I X=-1 D Q
  1. . S SDVISITCRT("SDAFLG")=1,SDVISITCRT("SDERR")=".01^"_SDVISITIN("SDDATE")_"^DATE INVALID FOR PATIENT,CANNOT CREATE VISIT .01 VALUE"
  1. D VSIT01^AUPNVSIT
  1. I '$D(X) S SDVISITCRT("SDAFLG")=1,SDVISITCRT("SDERR")=".01^"_SDVISITIN("SDDATE")_"^DATE INVALID FOR PATIENT,CANNOT CREATE VISIT .01 VALUE" Q
  1. S SDFDA="SDFDA(9000010,""+1,"")"
  1. S @SDFDA@(.01)=$G(SDVISITIN("SDDATE"))
  1. S @SDFDA@(.02)=$$NOW^XLFDT
  1. S @SDFDA@(.03)=$G(SDVISITIN("SDTYPE"))
  1. S @SDFDA@(.05)=$G(SDVISITIN("SDPAT"))
  1. S @SDFDA@(.06)=$G(SDVISITIN("SDLOC"))
  1. S @SDFDA@(.07)=$G(SDVISITIN("SDCAT"))
  1. S @SDFDA@(.08)=$G(SDVISITIN("SDCLN"))
  1. S @SDFDA@(.12)=$G(SDVISITIN("SDPVL"))
  1. S @SDFDA@(.13)=DT
  1. S @SDFDA@(.18)=$G(SDVISITIN("SDCODT"))
  1. S @SDFDA@(.21)=$G(SDVISITIN("SDVELG"))
  1. S @SDFDA@(.22)=$G(SDVISITIN("SDHL"))
  1. S @SDFDA@(.23)=$G(SDVISITIN("SDUSR"))
  1. S @SDFDA@(.24)=$G(SDVISITIN("SDOPT"))
  1. S @SDFDA@(.25)=$G(SDVISITIN("SDPROT"))
  1. S @SDFDA@(2101)=$S($G(SDVISITIN("SDOLOC"))]"":SDVISITIN("SDOLOC"),1:"")
  1. S VID=$$GETVID^VSITVID S @SDFDA@(15001)=VID
  1. D UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
  1. ;
  1. I $D(SDMSG) S SDVISITCRT("SDAFLG")=1,SDVISITCRT("SDERR")=".01^"_SDVISITIN("CDT")_"^VISIT CREATION FAILED" Q
  1. S SDVISITCRT("SDVSIT")=+SDIEN(1)
  1. I $T(GETVID^VSITVID)]"",$$GET1^DIQ(150.9,"1,",402,"I")]"" D
  1. . S VID=$$GETVID^VSITVID
  1. . S DIE=9000010,DA=SDVISITCRT("SDVSIT"),DR="15001///"_VID
  1. . D ^DIE K VID,DIE,DR,DA
  1. S SDVISITCRT("NEW")=1
  1. Q
  1. ;
  1. VALVISIT(SDVSTARRAY,SDVISITIN) ;Validation for SDVISITIN variables
  1. ;
  1. S SDVSTARRAY("SDAPDT")=$G(SDVISITIN("APPT DATE"))
  1. S SDVSTARRAY("SDCAT")=$G(SDVISITIN("SDCAT"))
  1. S SDVSTARRAY("SDEVM")=$G(SDVISITIN("SDEVM"))
  1. S SDVSTARRAY("SDDATE")=$G(SDVISITIN("SDDATE"))
  1. S SDVSTARRAY("SDHL")=$G(SDVISITIN("SDHL"))
  1. S SDVSTARRAY("SDLOC")=$G(SDVISITIN("SDLOC"))
  1. S SDVSTARRAY("SDCODT")=$G(SDVISITIN("SDCODT"))
  1. S SDVSTARRAY("SDOLOC")=$G(SDVISITIN("SDOLOC"))
  1. S SDVSTARRAY("SDOPT")=$G(SDVISITIN("SDOPT"))
  1. S SDVSTARRAY("SDPAT")=$G(SDVISITIN("SDPAT"))
  1. S SDVSTARRAY("SDPROT")=$G(SDVISITIN("SDPROT"))
  1. S SDVSTARRAY("SDPVL")=$G(SDVISITIN("SDPVL"))
  1. S SDVSTARRAY("SDTPB")=$G(SDVISITIN("SDTPB"))
  1. S SDVSTARRAY("SDTYPE")=$G(SDVISITIN("SDTYPE"))
  1. S SDVSTARRAY("SDUSR")=$G(SDVISITIN("SDUSR"))
  1. S SDVSTARRAY("SDVELG")=$G(SDVISITIN("SDVELG"))
  1. S SDVSTARRAY("SDVSIT")=$G(SDVISITIN("SDVSIT"))
  1. S SDVSTARRAY("SDADD")=$G(SDVISITIN("SDADD"))
  1. ; EDIT PASSED-IN VARIABLES
  1. N DIC,X,Y
  1. S:$P(SDVSTARRAY("SDDATE"),".",2)="" SDVSTARRAY("SDDATE")=+SDVSTARRAY("SDDATE")_".12"
  1. S SDVSTARRAY("SDDATE")=$E(SDVSTARRAY("SDDATE"),1,12)
  1. S:'$D(SDVSTARRAY("SDTYPE")) SDVSTARRAY("SDTYPE")="I"
  1. I SDVSTARRAY("SDTYPE")="" S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".03^"_SDVSTARRAY("SDTYPE")_"^TYPE OF VISIT MISSING" Q
  1. S:$G(SDVSTARRAY("SDCAT"))="" SDVSTARRAY("SDCAT")="A"
  1. S:$E(SDVSTARRAY("SDPAT"))="`" SDVSTARRAY("SDPAT")=$E(SDVSTARRAY("SDPAT"),2,99)
  1. I '$D(^AUPNPAT(SDVSTARRAY("SDPAT"),0)) D Q
  1. . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".05^"_SDVSTARRAY("SDPAT")_"^PATIENT NOT IN AUPNPAT GLOBAL" Q
  1. S:$E(SDVSTARRAY("SDLOC"))="`" SDVSTARRAY("SDLOC")=$E(SDVSTARRAY("SDLOC"),2,99)
  1. I '$D(^AUTTLOC(SDVSTARRAY("SDLOC"),0)) S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".06^"_SDVSTARRAY("SDLOC")_"^LOCATION PTR NOT IN AUTTLOC" Q
  1. I $D(SDVSTARRAY("SDOLOC")),SDVSTARRAY("SDOLOC")?.E1C.E D Q
  1. . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")="2101^"_SDVSTARRAY("SDOLOC")_"^OUTSIDE LOCATION FAILED INPUT TX" Q
  1. I $G(SDVSTARRAY("SDOLOC"))]"",$L(SDVSTARRAY("SDOLOC"))<2!($L(SDVSTARRAY("SDOLOC"))>50) D Q
  1. . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")="2101^"_SDVSTARRAY("SDOLOC")_"^OUTSIDE LOCATION FAILED INPUT TX" Q
  1. I $D(SDVSTARRAY("SDCLN")),SDVSTARRAY("SDCLN")="" K SDVSTARRAY("SDCLN") Q
  1. Q:'$D(SDVSTARRAY("SDCLN"))
  1. S:$E(SDVSTARRAY("SDCLN"))="`" SDVSTARRAY("SDCLN")=$E(SDVSTARRAY("SDCLN"),2,99)
  1. I SDVSTARRAY("SDCLN")?1N.N,'$D(^DIC(40.7,SDVSTARRAY("SDCLN"),0)) D Q
  1. . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".08^"_SDVSTARRAY("SDCLN")_"^CLINIC NOT VALID" Q
  1. I SDVSTARRAY("SDCLN")'?1N.N S X=SDVSTARRAY("SDCLN"),DIC="^DIC(40.7,",DIC(0)="M" D ^DIC S:+Y>0 SDVSTARRAY("SDCLN")=+Y
  1. I SDVSTARRAY("SDCLN")'?1N.N S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".08^"_SDVSTARRAY("SDCLN")_"^CLINIC NOT VALID" Q
  1. I $D(SDVSTARRAY("SDTPB")) S X="`"_SDVSTARRAY("SDTPB") I '$D(X) D Q
  1. . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".04^"_SDVSTARRAY("SDTPB")_"^.04 VALUE MUST BE IN INTERNAL FORMAT AND PASS INPUT TX"
  1. ;
  1. I $D(SDVSTARRAY("SDPVL")),'$D(^AUPNVSIT(SDVSTARRAY("SDPVL")))!($P($G(^AUPNVSIT(SDVSTARRAY("SDPVL"),0)),U,11)) D Q
  1. . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".12^"_SDVSTARRAY("SDPVL")_"^MUST BE INTERNAL VALUE AND VALID VISIT PTR"
  1. ;
  1. I $G(SDVSTARRAY("SDEVM"))]"",'SDVSTARRAY("SDEVM") D Q
  1. . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".17^"_SDVSTARRAY("SDEVM")_"^EVAL&MAN NOT VALID INTERNAL FORMAT"
  1. ;
  1. I $G(SDVSTARRAY("SDCODT"))]"" S X=$$FMTE^XLFDT(SDVSTARRAY("SDCODT")) X $P(^DD(9000010,.18,0),U,5,99) I '$D(X) D Q
  1. . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".18^"_SDVSTARRAY("SDCODT")_"^CHECK OUT DATE/TIME FAILED INPUT TX"
  1. ;
  1. I $G(SDVSTARRAY("SDVELG"))]"",'SDVSTARRAY("SDVELG") D Q
  1. . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".21^"_SDVSTARRAY("SDVELG")_"^VA ELIG NOT VALID INTERNAL FORMAT"
  1. ;
  1. I $G(SDVSTARRAY("SDHL"))]"",'SDVSTARRAY("SDHL") D Q
  1. . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".22^"_SDVSTARRAY("SDHL")_"^HOSPITAL LOCATION NOT VALID INTERNAL FORMAT"
  1. ;
  1. I $G(SDVSTARRAY("SDOPT"))]"",'SDVSTARRAY("SDOPT") D Q
  1. . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".24^"_SDVSTARRAY("SDOPT")_"^OPTION USED TO CREATE NOT VALID INTERNAL FORMAT"
  1. Q
  1. ;
  1. I $G(SDVSTARRAY("SDPROT"))]"",'SDVSTARRAY("SDPROT") D Q
  1. . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".25^"_SDVSTARRAY("SDPROT")_"^PROTOCOL USED TO CREATE NOT VALID INTERNAL FORMAT"
  1. ;
  1. I SDVSTARRAY("SDAPDT")]"" S X=$$FMTE^XLFDT(SDVSTARRAY("SDAPDT")) X $P(^DD(9000010,.26,0),U,5,99) I '$D(X) D Q
  1. . S SDVSTARRAY("SDAFLG")=1,SDVSTARRAY("SDERR")=".26^"_SDVSTARRAY("SDAPDT")_"^APPT DATE/TIME FAILED INPUT TX - MUST BE IN INTERNAL FM FORMAT"
  1. Q
  1. ;
  1. CLNUP ;
  1. K AUPNPAT,AUPNDAYS,SDVISITIN,SDVISITCRT,SDVSTARRAY
  1. Q