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