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

SDES2GETAPPTREQ.m

Go to the documentation of this file.
SDES2GETAPPTREQ ;ALB/BWF,JAS,BWF,JAS - SDES2 GET APPT REQ RPCS ; OCT 04, 2024
 ;;5.3;Scheduling;**873,877,878,880,890,893**;Aug 13, 1993;Build 6
 ;;Per VHA Directive 6402, this routine should not be modified
 ;
 ; Reference to ^VA(200 in ICR #10060 ;
 Q
 ;
 ; For an example of the return object, see SDES2GETREQWRAP due to its length.
 ; If you add new components to the JSON return object here, document
 ; in header of SDES2GETREQWRAP, initialize in APPTREQUEST.
 ;
 ; Input:
 ; SDCONTEXT
 ; SDINPUT("PATIENT IEN")=Patient DFN from the PATIENT file (#2)
 ;
GETREQSBYDFN(JSONRETURN,SDCONTEXT,SDINPUT)  ; SDES2 GET APPT REQ BY DFN
 N VRET,ERRORS,REQUESTIEN,REQUEST,DFN,SDDUZ
 ;
 D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
 I $D(ERRORS) S ERRORS("Request",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
 D VALFILEIEN^SDES2VALUTIL(.VRET,.ERRORS,2,$G(SDINPUT("PATIENT IEN")),1,,1,2)
 I $D(ERRORS) S ERRORS("Request",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
 ;
 S SDDUZ=$S($G(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)
 S DFN=$G(SDINPUT("PATIENT IEN"))
 S REQUESTIEN=0
 F  S REQUESTIEN=$O(^SDEC(409.85,"B",DFN,REQUESTIEN)) Q:'REQUESTIEN  D
 .I $$GET1^DIQ(409.85,REQUESTIEN,23,"I")="C" Q
 .D GETREQUEST(.REQUEST,REQUESTIEN,SDDUZ)
 I '$D(REQUEST) S REQUEST("Request",1)=""
 D BUILDJSON^SDES2JSON(.JSONRETURN,.REQUEST)
 Q
 ;
 ; Input:
 ; SDCONTEXT
 ; SDINPUT("REQUEST IEN")=Request IEN from SDEC APPT REQUEST (#409.85)
 ;
GETREQBYREQIEN(JSONRETURN,SDCONTEXT,SDINPUT) ;GET APPT REQ BY IEN
 N ERRORS,REQUEST,SDDUZ
 ;
 D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
 I $D(ERRORS) S ERRORS("Request",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
 D VALFILEIEN^SDES2VALUTIL(.VRET,.ERRORS,409.85,$G(SDINPUT("REQUEST IEN")),1,,3,4)
 I $D(ERRORS) S ERRORS("Request",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
 ;
 S SDDUZ=$S($G(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)
 D GETREQUEST(.REQUEST,$G(SDINPUT("REQUEST IEN")),SDDUZ)
 I '$D(REQUEST) S REQUEST("Request",1)=""
 D BUILDJSON^SDES2JSON(.JSONRETURN,.REQUEST)
 Q
 ;
GETREQBYTYPEVET(JSONRETURN,SDCONTEXT,SDINPUT) ;GET APPT REQ BY TYPE VET
 N ERRORS,REQUEST,COUNT,REQDATE,REQUESTIEN,SDDUZ
 D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
 I $D(ERRORS) S ERRORS("Request",1)="" D BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS) Q
 S SDDUZ=$S($G(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)
 S COUNT=0
 S REQDATE=0 F  S REQDATE=$O(^SDEC(409.85,"E","O",REQDATE)) Q:'REQDATE!(COUNT=200)  D
 .S REQUESTIEN=0 F  S REQUESTIEN=$O(^SDEC(409.85,"E","O",REQDATE,REQUESTIEN)) Q:'REQUESTIEN!(COUNT=200)  D
 ..I '$D(^SDEC(409.85,"TYPE","VETERAN",REQUESTIEN)) Q
 ..S COUNT=COUNT+1
 ..D GETREQUEST(.REQUEST,REQUESTIEN,SDDUZ)
 I '$D(REQUEST) S REQUEST("Request",1)=""
 D BUILDJSON^SDES2JSON(.JSONRETURN,.REQUEST)
 Q
 ;
BUILDPATCOMMENTS(REQUEST,REQUESTIEN,NUM) ;
 N SUBIEN,COUNT
 S SUBIEN=0,COUNT=0
 F  S SUBIEN=$O(^SDEC(409.85,REQUESTIEN,"PATCOM",SUBIEN)) Q:'SUBIEN  D
 .S COUNT=COUNT+1
 .S REQUEST("Request",NUM,"PatientComment",COUNT,"Comment")=$$GET1^DIQ(409.855,SUBIEN_","_REQUESTIEN_",",.01,"E")
 Q
 ;
BUILDCOMMAUDIT(REQUEST,REQUESTIEN,NUM) ;Comments Audit Multiple (#27)
 N SUBIEN,COUNT
 S SUBIEN=0,COUNT=0
 F  S SUBIEN=$O(^SDEC(409.85,REQUESTIEN,"COMAUD",SUBIEN)) Q:'SUBIEN  D
 .S COUNT=COUNT+1
 .S REQUEST("Request",NUM,"CommentMultiple",COUNT,"DateCommAdded")=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.8527,SUBIEN_","_REQUESTIEN_",",.01,"I"))
 .S REQUEST("Request",NUM,"CommentMultiple",COUNT,"CommAddedByDUZ")=$$GET1^DIQ(409.8527,SUBIEN_","_REQUESTIEN_",",1,"I")
 .S REQUEST("Request",NUM,"CommentMultiple",COUNT,"CommAddedByName")=$$GET1^DIQ(409.8527,SUBIEN_","_REQUESTIEN_",",1,"E")
 .S REQUEST("Request",NUM,"CommentMultiple",COUNT,"Comment")=$$GET1^DIQ(409.8527,SUBIEN_","_REQUESTIEN_",",2,"I")
 Q
 ;
BUILDMRTCPIDS(REQUEST,REQUESTIEN,NUM) ;MRTC PID entries
 N SUBIEN,DATE,COUNT
 S SUBIEN=0,COUNT=0
 F  S SUBIEN=$O(^SDEC(409.85,REQUESTIEN,5,SUBIEN)) Q:'SUBIEN  D
 .S COUNT=COUNT+1
 .S DATE=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.851,SUBIEN_","_REQUESTIEN_",",.01,"I"))
 .S REQUEST("Request",NUM,"MRTC",COUNT,"PatientIndicatedDate")=DATE
 Q
 ;
BUILDMRTCS(REQUEST,REQUESTIEN,NUM) ;
 N SUBIEN,COUNT,MIENS,CHILDIEN
 S SUBIEN=0,COUNT=0
 F  S SUBIEN=$O(^SDEC(409.85,REQUESTIEN,2,SUBIEN)) Q:'SUBIEN  D
 .S COUNT=COUNT+1
 .S MIENS=SUBIEN_","_REQUESTIEN_","
 .S CHILDIEN=$$GET1^DIQ(409.852,MIENS,.01,"I")
 .S REQUEST("Request",NUM,"MRTC",COUNT,"ChildRequestIEN")=CHILDIEN
 .S REQUEST("Request",NUM,"MRTC",COUNT,"LinkedAppointmentIEN")=$$GET1^DIQ(409.852,MIENS,.02,"I")
 .S REQUEST("Request",NUM,"MRTC",COUNT,"ChildRequestSequenceNumber")=$$GET1^DIQ(409.85,CHILDIEN,43.1,"I")
 S REQUEST("Request",NUM,"MRTCTotal")=COUNT
 Q
 ;
BUILDSDECONTACT(REQUEST,REQUESTIEN,NUM,REQUESTTYPE) ;get consult/recall
 N CONTACTIEN,SUBIEN,CIENS,COUNT,CONTARY,CONTACTYPE,CONTACTS,ERRORS
 S COUNT=0,CONTACTIEN=0
 S CONTACTIEN=$$GETCONTIEN^SDESCONTACTS(.ERRORS,REQUESTIEN,REQUESTTYPE)
 I 'CONTACTIEN S REQUEST("Request",NUM,"Contact",1)="" Q
 S SUBIEN=$$GET1^DIQ(409.86,CONTACTIEN,2.2,"I")-1
 F  S SUBIEN=$O(^SDEC(409.86,CONTACTIEN,1,SUBIEN)) Q:'SUBIEN  D
 .S CIENS=SUBIEN_","_CONTACTIEN_","
 .S CONTACTYPE=$$GET1^DIQ(409.863,CIENS,1,"I")
 .I $L($G(CONTACTYPE)) D
 ..S CONTARY(CONTACTYPE)=$G(CONTARY(CONTACTYPE))+1
 ..S COUNT=COUNT+1
 ..S REQUEST("Request",NUM,"SdecContactNumberOfCalls")=$G(CONTARY("C"))
 ..S REQUEST("Request",NUM,"SdecContactNumberOfEmailContact")=$G(CONTARY("E"))
 ..S REQUEST("Request",NUM,"SdecContactNumberOfTextContact")=$G(CONTARY("T"))
 ..S REQUEST("Request",NUM,"SdecContactNumberOfSecureMessage")=$G(CONTARY("S"))
 ..S REQUEST("Request",NUM,"SdecContactNumberOfLetters")=$G(CONTARY("L"))
 ..S:($G(CONTACTYPE)="L") REQUEST("Request",NUM,"SdecContactDateOfLastLetterSent")=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.863,CIENS,.01,"I"))
 .S:('$D(REQUEST("Request",NUM,"SdecContactDateOfLastLetterSent"))) REQUEST("Request",NUM,"SdecContactDateOfLastLetterSent")=""
 S REQUEST("Request",NUM,"SdecContactNumberOfContacts")=COUNT
 D BLDCONTACT^SDESCONTACTS(.CONTACTS,CONTACTIEN)
 D DISPMULT^SDESCONTACTS(.CONTACTS,CONTACTIEN)
 I $D(CONTACTS) M REQUEST("Request",NUM)=CONTACTS Q
 I '$D(CONTACTS) S REQUEST("Request",NUM,"Contact",1)=""
 Q
BUILDCPRSPREREQS(REQUEST,REQUESTIEN,NUM) ;
 N SUBIEN,COUNT,PIENS
 S SUBIEN=0,COUNT=0
 F  S SUBIEN=$O(^SDEC(409.85,REQUESTIEN,8,SUBIEN)) Q:'SUBIEN  D
 .S COUNT=COUNT+1
 .S PIENS=SUBIEN_","_REQUESTIEN_","
 .S REQUEST("Request",NUM,"CPRSPreRequisites",COUNT,"PreRequisite")=$$GET1^DIQ(409.8548,PIENS,.01,"E")
 Q
 ;
GETREQUEST(REQUEST,REQUESTIEN,SDDUZ) ;
 N APPT,REQUESTARY,ERR,IENS,FN,REQDATA,NUM,CLINSTOPIEN,CLINCREDIEN,DFN,SENSITIVE,CONTACTIEN,PRIOGROUP
 S FN=409.85,NUM=""
 S NUM=$O(REQUEST("Request",NUM),-1)+1
 S IENS=REQUESTIEN_","
 D GETS^DIQ(FN,IENS,"**","IE","REQDATA","ERR")
 Q:$D(ERR)
 S SDDUZ=$S($G(SDDUZ)'="":SDDUZ,1:DUZ)
 ; Check the AMIS Stop codes on clinic
 S CLINSTOPIEN=$S(REQDATA(FN,REQUESTIEN_",",8.5,"I")'="":REQDATA(FN,REQUESTIEN_",",8.5,"I"),1:$$GET1^DIQ(44,REQDATA(FN,REQUESTIEN_",",8,"I")_",",8,"I"))
 S CLINCREDIEN=$S(REQDATA(FN,REQUESTIEN_",",13.5,"I")'="":REQDATA(FN,REQUESTIEN_",",13.5,"I"),1:$$GET1^DIQ(44,REQDATA(FN,REQUESTIEN_",",8,"I")_",",2503,"I"))
 ;
 I $D(^SDEC(409.85,REQUESTIEN,"PATCOM")) D BUILDPATCOMMENTS(.REQUEST,REQUESTIEN,NUM)
 I '$D(^SDEC(409.85,REQUESTIEN,"PATCOM")) S REQUEST("Request",NUM,"PatientComment",1)=""
 ;
 I $D(^SDEC(409.85,REQUESTIEN,"COMAUD")) D BUILDCOMMAUDIT(.REQUEST,REQUESTIEN,NUM)
 I '$D(^SDEC(409.85,REQUESTIEN,"COMAUD")) S REQUEST("Request",NUM,"CommentMultiple",1)=""
 ;
 I $D(^SDEC(409.85,REQUESTIEN,8)) D BUILDCPRSPREREQS(.REQUEST,REQUESTIEN,NUM)
 I '$D(^SDEC(409.85,REQUESTIEN,8)) S REQUEST("Request",NUM,"CPRSPreRequisites",1)=""
 ;
 I $D(^SDEC(409.85,REQUESTIEN,2)) D BUILDMRTCS(.REQUEST,REQUESTIEN,NUM) ;MRTCs
 I '$D(^SDEC(409.85,REQUESTIEN,2)) S REQUEST("Request",NUM,"MRTC",1)=""
 ;
 I $D(^SDEC(409.85,REQUESTIEN,5)) D BUILDMRTCPIDS(.REQUEST,REQUESTIEN,NUM) ;MRTC PIDs
 ;
 D GETCONTACTIEN^SDES2CONTACTS(.CONTACTIEN,REQUESTIEN_";SDEC(409.85,")
 D BUILDSDECONTACT(.REQUEST,REQUESTIEN,NUM,"A")
 I 'CONTACTIEN D SDECONTACT^SDES2GETREQS(.REQUEST,NUM)
 ;
 S DFN=REQDATA(FN,REQUESTIEN_",",.01,"I")
 S PRIOGROUP=$$PRIORITY^DGENA(DFN)
 I PRIOGROUP S PRIOGROUP="GROUP "_PRIOGROUP
 ;
 S REQUEST("Request",NUM,"Type")="Appt Request"
 S REQUEST("Request",NUM,"PatientIEN")=DFN
 S REQUEST("Request",NUM,"PatientICN")=$$GETPATICN^SDESINPUTVALUTL(DFN)
 S REQUEST("Request",NUM,"PatientName")=REQDATA(FN,REQUESTIEN_",",.01,"E") ;
 S REQUEST("Request",NUM,"PatientPhone")=$$GET1^DIQ(2,DFN_",",.131,"E")
 S REQUEST("Request",NUM,"RequestIEN")=REQUESTIEN
 S REQUEST("Request",NUM,"RequestComments")=REQDATA(FN,REQUESTIEN_",",25,"E")
 S REQUEST("Request",NUM,"CreateDate")=$$FMTISO^SDAMUTDT(REQDATA(FN,REQUESTIEN_",",1,"I"))
 S REQUEST("Request",NUM,"InstitutionIEN")=REQDATA(FN,REQUESTIEN_",",2,"I")
 S REQUEST("Request",NUM,"InstitutionName")=REQDATA(FN,REQUESTIEN_",",2,"E")
 S REQUEST("Request",NUM,"InstitutionNumber")=$$GET1^DIQ(4,REQDATA(FN,REQUESTIEN_",",2,"I"),99)
 S REQUEST("Request",NUM,"RequestSubType")=REQDATA(FN,REQUESTIEN_",",4,"E")
 S REQUEST("Request",NUM,"ChildRequestSequenceNumber")=$$GET1^DIQ(409.85,REQUESTIEN,43.1,"I")
 S REQUEST("Request",NUM,"ClinicIEN")=REQDATA(FN,REQUESTIEN_",",8,"I")
 S REQUEST("Request",NUM,"ClinicName")=REQDATA(FN,REQUESTIEN_",",8,"E")
 S REQUEST("Request",NUM,"ClinicStopCodeIEN")=CLINSTOPIEN
 S REQUEST("Request",NUM,"ClinicStopCodeName")=$$GET1^DIQ(40.7,CLINSTOPIEN_",",.01,"E")
 S REQUEST("Request",NUM,"ClinicStopCodeAMIS")=$$GET1^DIQ(40.7,CLINSTOPIEN_",",1,"E")
 S REQUEST("Request",NUM,"ClinicSecondaryStopCodeIEN")=REQDATA(FN,REQUESTIEN_",",8.6,"I")
 S REQUEST("Request",NUM,"ClinicSecondaryStopCodeName")=REQDATA(FN,REQUESTIEN_",",8.6,"E")
 S REQUEST("Request",NUM,"ClinicSecondaryStopCodeAMIS")=$$GET1^DIQ(40.7,REQDATA(FN,REQUESTIEN_",",8.6,"I"),1)
 S REQUEST("Request",NUM,"CreditStopCodeIEN")=CLINCREDIEN
 S REQUEST("Request",NUM,"CreditStopCodeName")=$$GET1^DIQ(40.7,CLINCREDIEN_",",.01,"E")
 S REQUEST("Request",NUM,"CreditStopCodeAMIS")=$$GET1^DIQ(40.7,CLINCREDIEN_",",1,"E")
 S REQUEST("Request",NUM,"DisplayClinicAppt")=$$GET1^DIQ(44,REQDATA(FN,REQUESTIEN_",",8,"I")_",",62,"E")
 S REQUEST("Request",NUM,"ApptType")=REQDATA(FN,REQUESTIEN_",",8.7,"E")
 S REQUEST("Request",NUM,"EnteredByName")=REQDATA(FN,REQUESTIEN_",",9,"E")
 S REQUEST("Request",NUM,"EnteredByIEN")=REQDATA(FN,REQUESTIEN_",",9,"I")
 S REQUEST("Request",NUM,"DateTimeEntered")=$$FMTISO^SDAMUTDT($G(REQDATA(FN,REQUESTIEN_",",9.5,"I")))
 S REQUEST("Request",NUM,"Priority")=REQDATA(FN,REQUESTIEN_",",10,"E")
 S REQUEST("Request",NUM,"EnrollmentPriorityGroup")=PRIOGROUP
 S REQUEST("Request",NUM,"ByPatientOrProvider")=REQDATA(FN,REQUESTIEN_",",11,"E")
 S REQUEST("Request",NUM,"ProviderIEN")=REQDATA(FN,REQUESTIEN_",",12,"I")
 S REQUEST("Request",NUM,"ProviderName")=REQDATA(FN,REQUESTIEN_",",12,"E")
 S REQUEST("Request",NUM,"ProviderSecID")=$$GET1^DIQ(200,REQDATA(FN,REQUESTIEN_",",12,"I"),205.1)
 S REQUEST("Request",NUM,"ScheduledDateOfAppt")=$$FMTISO^SDAMUTDT(REQDATA(FN,REQUESTIEN_",",13,"I"))
 S REQUEST("Request",NUM,"DateLinkedApptMade")=$$FMTISO^SDAMUTDT(REQDATA(FN,REQUESTIEN_",",13.1,"I"))
 S REQUEST("Request",NUM,"LinkedApptClinic")=REQDATA(FN,REQUESTIEN_",",13.2,"E")
 S REQUEST("Request",NUM,"LinkedApptInstitutionName")=REQDATA(FN,REQUESTIEN_",",13.3,"E")
 S REQUEST("Request",NUM,"LinkedApptInstitutionNumber")=REQDATA(FN,REQUESTIEN_",",13.3,"I")
 S REQUEST("Request",NUM,"LinkedApptStopCode")=REQDATA(FN,REQUESTIEN_",",13.4,"E")
 S REQUEST("Request",NUM,"LinkedApptCreditStopCode")=REQDATA(FN,REQUESTIEN_",",13.5,"E")
 S REQUEST("Request",NUM,"LinkedApptStationNumber")=REQDATA(FN,REQUESTIEN_",",13.6,"E")
 S REQUEST("Request",NUM,"LinkedApptEnteredBy")=REQDATA(FN,REQUESTIEN_",",13.7,"E")
 S REQUEST("Request",NUM,"LinkedApptStatus")=REQDATA(FN,REQUESTIEN_",",13.8,"E")
 S REQUEST("Request",NUM,"ServiceConnectedPercentage")=REQDATA(FN,REQUESTIEN_",",14,"E")
 S REQUEST("Request",NUM,"PatientIndicatedDate")=$$FMTISO^SDAMUTDT(REQDATA(FN,REQUESTIEN_",",22,"I"))
 S REQUEST("Request",NUM,"Status")=(REQDATA(FN,REQUESTIEN_",",23,"E"))
 S REQUEST("Request",NUM,"MRTCNeeded")=REQDATA(409.85,REQUESTIEN_",",41,"E")
 S REQUEST("Request",NUM,"MRTCDaysBetweenAppts")=REQDATA(409.85,REQUESTIEN_",",42,"E")
 S REQUEST("Request",NUM,"MRTCHowManyNeeded")=REQDATA(409.85,REQUESTIEN_",",43,"E")
 S REQUEST("Request",NUM,"EASTrackingNumber")=REQDATA(FN,REQUESTIEN_",",100,"E")
 S REQUEST("Request",NUM,"DispositionedDate")=$$FMTISO^SDAMUTDT(REQDATA(FN,REQUESTIEN_",",19,"I"))
 S REQUEST("Request",NUM,"DispositionedBy")=REQDATA(FN,REQUESTIEN_",",20,"I")
 S REQUEST("Request",NUM,"DispositionedBy")=REQDATA(FN,REQUESTIEN_",",20,"E")
 S REQUEST("Request",NUM,"DispositionReason")=REQDATA(FN,REQUESTIEN_",",21,"E")
 S REQUEST("Request",NUM,"DispositionIEN")=REQDATA(FN,REQUESTIEN_",",21,"I")
 S REQUEST("Request",NUM,"ServiceConnectedPriority")=REQDATA(FN,REQUESTIEN_",",15,"E")
 S REQUEST("Request",NUM,"PatientStatus")=REQDATA(FN,REQUESTIEN_",",.02,"E")
 S REQUEST("Request",NUM,"ParentRequestIEN")=REQDATA(FN,REQUESTIEN_",",43.8,"I")
 S REQUEST("Request",NUM,"ModalityName")=REQDATA(FN,REQUESTIEN_",",6,"E")
 S REQUEST("Request",NUM,"ModalityCode")=REQDATA(FN,REQUESTIEN_",",6,"I")
 S REQUEST("Request",NUM,"CPRSOrderID")=REQDATA(FN,REQUESTIEN_",",46,"I")
 S REQUEST("Request",NUM,"CPRSTimeSensitive")=REQDATA(FN,REQUESTIEN_",",47,"I")
 S REQUEST("Request",NUM,"PIDChangeAllowed")=$S(+$G(REQDATA(FN,REQUESTIEN_",",49,"I"))=1:1,1:0)
 S REQUEST("Request",NUM,"PatientLast4")=$$LAST4SSN^SDESINPUTVALUTL(DFN)
 S REQUEST("Request",NUM,"DuplicateReason")=$G(REQDATA(FN,REQUESTIEN_",",51,"E"))
 ; sensitive record indicator
 D SENSITIVE^SDES2UTIL(.SENSITIVE,DFN,$G(SDDUZ))
 S REQUEST("Request",NUM,"SensitiveRecord")=$G(SENSITIVE(1))
 ; build recall and consult
 D RECALL^SDES2GETREQS(.REQUEST,NUM)
 D CONSULT^SDES2GETREQS(.REQUEST,NUM)
 Q