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

SDESCRTWALKIN.m

Go to the documentation of this file.
SDESCRTWALKIN  ;ALB/LAB,DJS,LAB - VISTA SCHEDULING WALK-IN RPC ; NOV 2,2023
 ;;5.3;Scheduling;**823,846,866**;Aug 13, 1993;Build 22
 ;;Per VHA Directive 6402, this routine should not be modified
 ;----------------- ----------------- ----------
 ; ^TMP($J SACC 2.3.2.5.1
 ;
SDECCRTWALKIN(RETN,STRT,ENDTM,DFN,PID,INSNM,CLIN,NOTE,APTYP,PTSTAT,APPTLEN,SRVCON,SRVPC,ELIG,OVB,PRIGRP,VGUID,MOD,STOP,SECSTP,COL,STATNUM,SDEAS) ;
 N ARRAY,%DT
 D BUILDARR(.ARRAY,$G(STRT),$G(ENDTM),$G(DFN),$G(PID),$G(INSNM),$G(CLIN),$G(NOTE),$G(APTYP),$G(PTSTAT),$G(APPTLEN),$G(SRVCON),$G(SRVPC),$G(ELIG),$G(OVB),$G(PRIGRP),$G(VGUID),$G(MOD),$G(STOP),$G(SECSTP),$G(COL),$G(STATNUM),$G(SDEAS))
 D CREATEWALKIN(.RETN,.ARRAY)
 Q
BUILDARR(ARRAY,STRT,ENDTM,DFN,PID,INSNM,CLIN,NOTE,APTYP,PTSTAT,APPTLEN,SRVCON,SRVPC,ELIG,OVB,PRIGRP,VGUID,MOD,STOP,SECSTP,COL,STATNUM,SDEAS) ;
 S ARRAY("APPT START")=$$FMTISO^SDAMUTDT($$NETTOFM^SDECDATE(STRT,"Y"),CLIN)
 S ARRAY("APPT END")=$$FMTISO^SDAMUTDT($$NETTOFM^SDECDATE(ENDTM,"Y"),CLIN)
 S ARRAY("DFN")=DFN
 S X=PID S %DT="" D ^%DT S PID=Y
 S ARRAY("PATIENT INDICATED DATE")=$$FMTISO^SDAMUTDT(PID,"Y")
 S ARRAY("CLINIC IEN")=CLIN
 S ARRAY("SDNOTE")=NOTE
 S ARRAY("APPOINTMENT TYPE IEN")=APTYP
 S ARRAY("APPOINTMENT TYPE NAME")=$$GET1^DIQ(409.1,$G(ARRAY("APPOINTMENT TYPE IEN")),.01,"E")
 S ARRAY("PATIENT STATUS")=PTSTAT
 S ARRAY("APPT LENGTH")=APPTLEN
 S ARRAY("SDSERVCONN")=SRVCON
 S ARRAY("SDSERVCONNPERC")=SRVPC
 S ARRAY("SDEAS")=SDEAS
 S ARRAY("SDPATELIG")=ELIG
 S ARRAY("OVERBOOK")=OVB
 S ARRAY("SDCOLLATERAL")=COL
 S ARRAY("INSTITUTION NAME")=INSNM
 S ARRAY("VAOS GUID")=VGUID
 S ARRAY("MODALITY")=MOD
 S ARRAY("STOP CODE")=STOP
 S ARRAY("SECONDARY STOP CODE")=SECSTP
 S ARRAY("PRIORITY GROUP")=PRIGRP
 S ARRAY("STATION NUMBER")=STATNUM
 Q
 ;
CREATEWALKIN(JSONRETURN,ARRAY) ;
 N X,Y,REQRESULT,REQARRAY,APPTARRAY,APPTRESULT,%,APPOINTMENT,APPTIEN,DISPRESULT
 N APPTRETURN,REQRETURN,CHECKIN,DA,DIK
 S ARRAY("RESOURCE IEN")=$S($G(ARRAY("CLINIC IEN"))="":"",1:$$GETRES^SDESINPUTVALUTL($G(ARRAY("CLINIC IEN")),1))
 D BLDREQARRAY(.REQARRAY,.ARRAY)
 D CREATEREQUEST^SDESCREATEAPPREQ(.REQRETURN,.REQARRAY)
 D DECODE^XLFJSON("REQRETURN","REQRESULT","ERROR")
 I $O(REQRESULT("Error",""))'="" D  Q
 . D BUILDERROR(.REQRESULT,.JSONRETURN)
 ;
 D BLDAPPTARRAY(.APPTARRAY,.ARRAY)
 K TMPJSONRETURN
 D CREATEAPPTS^SDESCRTAPPTWRAP(.APPTRETURN,.APPTARRAY)
 D DECODE^XLFJSON("APPTRETURN","APPTRESULT","ERROR")
 I $O(APPTRESULT("Error",""))'="" D  Q
 . S DIK="^SDEC(409.85,",DA=$G(REQRESULT("Request","IEN")) D ^DIK
 . D BUILDERROR(.APPTRESULT,.JSONRETURN)
 ;
 D DISPOSITIONREQ(.DISPRESULT,.REQRESULT,.REQUEST)
 ;
 S APPTIEN=APPTRESULT("Appointment","IEN")
 D CHECKIN^SDESCHECKIN(.CHECKIN,APPTIEN,$$FMTISO^SDAMUTDT($$NOW^XLFDT)) ;
 M APPOINTMENT=REQRESULT
 M APPOINTMENT=APPTRESULT
 D BUILDJSON^SDESBUILDJSON(.JSONRETURN,.APPOINTMENT)
 Q
 ;
SETEMPTYOBJECT(RETURNERROR) ;set the return object into null if an error occur
 S RETURNERROR("Request","IEN")=""
 S RETURNERROR("Appointment","IEN")=""
 Q
 ;
DISPOSITIONREQ(DISPRESULT,REQRESULT,REQUEST) ;
 NEW REQUESTIEN,EAS,PCMT,DISPOSITION,DISPBY,DISPDATE
 S REQUESTIEN=$G(REQRESULT("Request","IEN"))
 S EAS=$G(REQUEST("EAS"))
 S PCMT=$G(REQUEST("VAOS GUID"))
 S DISPOSITION="REMOVED/SCHEDULED-ASSIGNED"
 S DISPBY=$G(DUZ)
 S DISPDATE=$TR($$FMTE^XLFDT($$NOW^XLFDT,"7DZ"),"/","-")
 D DISPOSITION^SDESARCLOSE(.DISPRESULT,$G(REQUESTIEN),$G(DISPOSITION),$G(DISPBY),$G(DISPDATE),$G(EAS),$G(PCMT))
 Q
 ;
BUILDERROR(RESULT,JSONRETURN) ;
 NEW RETURNERROR
 M RETURNERROR=RESULT
 D SETEMPTYOBJECT(.RETURNERROR)
 D BUILDJSON^SDESBUILDJSON(.JSONRETURN,.RETURNERROR)
 Q
 ;
BLDREQARRAY(REQARRAY,ARRAY) ;build the array to call SDES CREATE APPT REQ
 N FDA,FDAERR,RETURNIEN
 S REQARRAY("DFN")=$G(ARRAY("DFN"))
 S REQARRAY("CREATE DATE")=$$FMTISO^SDAMUTDT(DT) ;Needs to be in ISO
 S REQARRAY("STATION NUMBER")=$G(ARRAY("STATION NUMBER"))
 S REQARRAY("INSTITUTION NAME")=$G(ARRAY("INSTITUTION NAME"))
 S REQARRAY("CLINIC IEN")=$G(ARRAY("CLINIC IEN"))
 S REQARRAY("REQUEST SUB TYPE")="APPT"
 S REQARRAY("REQUESTED BY")="PATIENT"
 S REQARRAY("PATIENT INDICATED DATE")=$G(ARRAY("PATIENT INDICATED DATE"))
 S REQARRAY("PRIORITY")="ASAP"
 S REQARRAY("PRIORITY GROUP")=$G(ARRAY("PRIORITY GROUP"))
 S REQARRAY("SERVICE CONNECTED")=$G(ARRAY("SDSERVCONN"))
 S REQARRAY("SERVICE CONNECTED PERCENTAGE")=$G(ARRAY("SDSERVCONNPERC"))
 S REQARRAY("STOP CODE")=$G(ARRAY("STOP CODE"))
 S REQARRAY("SECONDARY STOP CODE")=$G(ARRAY("SECONDARY STOP CODE"))
 S REQARRAY("MODALITY")=$G(ARRAY("MODALITY"))
 S REQARRAY("APPOINTMENT TYPE IEN")=$G(ARRAY("APPOINTMENT TYPE IEN"))
 S REQARRAY("APPOINTMENT TYPE NAME")=$G(ARRAY("APPOINTMENT TYPE NAME"))
 S REQARRAY("PATIENT STATUS")=$G(ARRAY("PATIENT STATUS"))
 S REQARRAY("VAOS GUID")=$G(ARRAY("VAOS GUID"))
 S REQARRAY("EAS")=$G(ARRAY("SDEAS"))
 S REQARRAY("REQUEST COMMENT")="AUTO-GENERATED WALKIN REQUEST"
 S REQARRAY("MRTC","NEEDED")="NO"
 S REQARRAY("MRTC","HOW MANY NEEDED")=0
 S REQARRAY("CPRS TIME SENSITIVE")="NO"
 S REQARRAY("CPRS ORDER NUMBER")=0
 Q
 ;
BLDAPPTARRAY(APPTARRAY,ARRAY) ;Build the appointment array to call SDES CREATE APPOINTMENTS
 S APPTARRAY(1)=$G(ARRAY("APPT START"))
 S APPTARRAY(2)=$G(ARRAY("APPT END"))
 S APPTARRAY(3)=$G(ARRAY("DFN"))
 S APPTARRAY(4)=$G(ARRAY("RESOURCE IEN"))
 S APPTARRAY(5)="y"                          ;walk-in
 S APPTARRAY(6)=$G(ARRAY("PATIENT INDICATED DATE")) ;this is the CID/PID Date Preferred
 S APPTARRAY(7)=""                           ;this is the EXTERNAL ID - (FREE TEXT 1-50), defaulted to NULL since this not needed
 S APPTARRAY(8)="A|"_$G(REQRESULT("Request","IEN"))
 S APPTARRAY(9)=""
 S APPTARRAY(10)=$G(ARRAY("CLINIC IEN"))
 S APPTARRAY(11)=$G(ARRAY("SDNOTE"))
 S APPTARRAY(12)=$G(ARRAY("APPOINTMENT TYPE IEN"))
 S APPTARRAY(12.5)=$G(ARRAY("APPOINTMENT TYPE NAME"))
 ;S APPTARRAY(12)=$$GET1^DIQ(409.1,$G(ARRAY("APPOINTMENT TYPE IEN")),.01,"E")
 S APPTARRAY(13)=$G(ARRAY("PATIENT STATUS"))
 S APPTARRAY(14)=$G(ARRAY("APPT LENGTH"))
 S APPTARRAY(15)=$G(ARRAY("SDSERVCONN"))
 S APPTARRAY(16)=$G(ARRAY("SDSERVCONNPERC"))
 S APPTARRAY(17)="FALSE"                     ;MRTC is set to FALSE since this is a walkin
 S APPTARRAY(18)=""                          ;parent request null
 S APPTARRAY(19)=$G(ARRAY("SDEAS"))
 S APPTARRAY(20)=$G(ARRAY("SDNOTE")) ;Appointment reason
 S APPTARRAY(21)=$G(ARRAY("SDPATELIG")) ;This is PATIENT ELIGIBILITY IEN pointer to DIC(8
 S APPTARRAY(22)=$G(ARRAY("OVERBOOK")) ;OVERBOOK (0 for no, 1 for yes)
 S APPTARRAY(23)=""                          ;LAB DATE/TIME - ISO FORMAT
 S APPTARRAY(24)=""                          ;XRAY DATE/TIME - ISO FORMAT
 S APPTARRAY(25)=""                          ;EKG DATE/TIME - ISO FORMAT
 S APPTARRAY(26)=4 ;Always set to '4' FOR WALKIN
 S APPTARRAY(27)=$G(ARRAY("SDCOLLATERAL")) ;COLLATERAL - 1 FOR YES
 S APPTARRAY(28)="W"                         ;Always set to 'W' FOR 'NEXT AVAILABLE' APPT.
 S APPTARRAY(29)=0 ;Always set to 0
 S APPTARRAY(30)=0
 Q
 ;