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

SDECALV.m

Go to the documentation of this file.
  1. SDECALV ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
  1. ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
  1. ;
  1. EN1(SDALVR) ;
  1. EN ;VISIT CREATION
  1. ;required:
  1. ; SDDATE
  1. ; SDLOC
  1. ; SDPAT
  1. ;optional:
  1. ; SDALV (used in SDECALV1)
  1. ; SDALVR (used in SDECALV1)
  1. ; SDAPDT
  1. ; SDCODT
  1. ; SDHL - HOSPITAL LOCATION id
  1. ; SDLOC
  1. ; SDOPT
  1. ; SDPROT
  1. ; SDPVL
  1. ; SDTYPE
  1. ; SDUSR
  1. ; SDVELG
  1. N D0,DA,DIC,DIE,DR
  1. N SDAFLG,SDCAT,SDCLN,SDVSIT
  1. N SDAPDT,SDCAT,SDCODT,SDDATE,SDHL,SDLOC,SDOLOC,SDOPT,SDPAT,SDPROT,SDPVL
  1. N SDTYPE,SDUSR,SDVELG
  1. D INIT^SDECALV1(.SDALVR)
  1. S SDAPDT=$G(SDALVR("APPT DATE"))
  1. S SDCAT=$G(SDALVR("SDCAT"))
  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 SDTYPE=$G(SDALVR("SDTYPE"))
  1. S SDUSR=$G(SDALVR("SDUSR"))
  1. S SDVELG=$G(SDALVR("SDVELG"))
  1. I $D(SDAFLG) D EOJ Q
  1. LOCK +^TMP("SDECALV",SDPAT):60
  1. I $D(SDADD) D GENVISIT,EOJ Q ; forced add
  1. Q
  1. ;
  1. AUTO ; NON-INTERACTIVE MODE
  1. S SDAVDC=9999999-$P(SDDATE,".")_"."_$P(SDDATE,".",2)
  1. F SDAI=0:0 S SDAI=$O(^AUPNVSIT("AA",SDPAT,SDAVDC,SDAI)) Q:SDAI="" D CHECK Q:SDVSIT
  1. Q:SDVSIT
  1. D GENVISIT
  1. Q
  1. ;
  1. CHECK ; CHECK VISIT AUTO MODE
  1. N SDAX
  1. S SDAX=^AUPNVSIT(SDAI,0)
  1. Q:$P(SDAX,U,11)
  1. I $D(SDCLN),$P(SDAX,U,8)'=SDCLN Q ;CHANGED THIS LINE ON 4/4/96 - DOES THIS FIX IT?
  1. I '$D(SDCLN),$P(SDAX,U,8)]"" Q ;if not passing clinic and visit has clinic do not select this visit
  1. Q:$P(SDAX,U,3)'=SDTYPE
  1. Q:$P(SDAX,U,6)'=SDLOC
  1. Q:$P(SDAX,U,7)'=SDCAT
  1. S SDVSIT=SDAI
  1. Q
  1. ;
  1. ;--------------------------------------------------------------
  1. ;
  1. GENVISIT ; GENERATE NEW VISIT
  1. ;INPUT:
  1. ; SDALVR("SDDATE") .01 VISIT/ADMIT DATE&TIME in fm format
  1. ; .02 DATE VISIT CREATED
  1. ; SDALVR("SDTYPE") .03 TYPE valid values:
  1. ; I:IHS
  1. ; C:CONTRACT
  1. ; T:TRIBAL
  1. ; O:OTHER
  1. ; 6:638 PROGRAM
  1. ; V:VA
  1. ; SDPAT .05 Patient pointer to PATIENT file 2
  1. ; SDLOC .06 LOC. OF ENCOUNTER pointer to LOCATION file
  1. ; SDCAT .07 Service Category
  1. ; SDCLN .08 DSS ID (Clinic Stop)
  1. ; SDPVL .12 Parent Visit Link
  1. ; .13 Date Last Modified in fm format
  1. ; SDCODT .18 Check out Date&Time
  1. ; SDVELG .21 Eligibility pointer to ELIGIBILITY CODE file 8
  1. ; SDHL .22 Hospital Location pointer to file 44
  1. ; SDUSR .23 Created by user pointer to NEW PERSON
  1. ; SDOPT .24 Option used to Create pointer to OPTION file
  1. ; SDPROT .25 Protocol pointer to PROTOCOL file
  1. ; SDOLOC 2101 outside location
  1. ;
  1. N AUPNDOB,AUPNDOD,AUPNSEX
  1. N SDDOB,SDDOD,SDFDA,SDIEN,SDMSG,SDSEX,X,Y,%DT
  1. S Y=SDPAT D ^AUPNPAT K Y
  1. S SDSEX=AUPNSEX,SDDOB=AUPNDOB,SDDOD=AUPNDOD
  1. S X=$G(SDDATE),%DT="TRXN" D ^%DT S X=Y I X=-1 S SDAFLG=2,SDAFLG("ERR")=".01^"_SDDATE_"^DATE INVALID FOR PATIENT,CANNOT CREATE VISIT .01 VALUE" Q
  1. D VSIT01^AUPNVSIT
  1. I '$D(X) S SDAFLG=2,SDAFLG("ERR")=".01^"_SDDATE_"^DATE INVALID FOR PATIENT,CANNOT CREATE VISIT .01 VALUE" Q
  1. S SDFDA="SDFDA(9000010,""+1,"")"
  1. S @SDFDA@(.01)=SDDATE
  1. S @SDFDA@(.02)=$$NOW^XLFDT
  1. S @SDFDA@(.03)=$G(SDTYPE)
  1. S @SDFDA@(.05)=$G(SDPAT)
  1. S @SDFDA@(.06)=$G(SDLOC)
  1. S @SDFDA@(.07)=$G(SDCAT)
  1. S @SDFDA@(.08)=$G(SDCLN)
  1. S @SDFDA@(.12)=$G(SDPVL)
  1. S @SDFDA@(.13)=DT
  1. S @SDFDA@(.18)=$G(SDCODT)
  1. S @SDFDA@(.21)=$G(SDVELG)
  1. S @SDFDA@(.22)=$G(SDHL)
  1. S @SDFDA@(.23)=$G(SDUSR)
  1. S @SDFDA@(.24)=$G(SDOPT)
  1. S @SDFDA@(.25)=$G(SDPROT)
  1. S @SDFDA@(2101)=$S($G(SDOLOC)]"":SDOLOC,1:"")
  1. S VID=$$GETVID^VSITVID S @SDFDA@(15001)=VID
  1. D UPDATE^DIE("","SDFDA","SDIEN","SDMSG")
  1. ;
  1. I $D(SDMSG) S SDAFLG=2,SDAFLG("ERR")=".01^"_SDALVR("CDT")_"^VISIT CREATION FAILED" Q
  1. S SDVSIT=+SDIEN(1)
  1. I $T(GETVID^VSITVID)]"",$P($G(^DIC(150.9,1,4)),U,2)]"" S VID=$$GETVID^VSITVID S DIE=9000010,DA=SDVSIT,DR="15001///"_VID D ^DIE K VID,DIE,DR,DA
  1. S SDVSIT("NEW")=1
  1. Q
  1. ;
  1. ;--------------------------------------------------------------
  1. ;
  1. INIT ; INITIALIZATION/EDIT INPUT VARIABLES
  1. D INIT^SDECALV1
  1. Q
  1. ;
  1. EOJ ; CLEAN UP
  1. LOCK -^TMP("SDECALV",SDPAT)
  1. ; The line below must 'hard set' the clinic code because
  1. ; ^DIE would have to be called recursively. An exception to the
  1. ; standard has been granted by DSM/OIRM.
  1. I SDVSIT,$D(SDCLN),$P(^AUPNVSIT(SDVSIT,0),U,8)="" S $P(^AUPNVSIT(SDVSIT,0),U,8)=SDCLN ; ***** BAD, VERY BAD, FORGIVE US PLEASE *****
  1. ;I SDVSIT,$P($G(^AUPNVSIT(SDVSIT,11)),U,4)="" S $P(^AUPNVSIT(SDVSIT,11),U,4)=$$UID^AUPNVSIT(SDVSIT) ;stuff UID if blank
  1. K X,Y
  1. K DIRUT,DTOUT,DUOUT
  1. K SDADD,SDADF
  1. K SDAC,SDAI,SDAL,SDALV,SDAO,SDAVD,SDAVDC,SDAX,SDA11
  1. I $D(SDALVR)\10 S SDALVR("SDPAT")=SDPAT,SDALVR("SDVSIT")=SDVSIT S:$D(SDVSIT("NEW")) SDALVR("SDVSIT","NEW")=SDVSIT("NEW") S:$D(SDAFLG) SDALVR("SDAFLG")=SDAFLG D EN1^SDECEKL
  1. Q