SDES2GETAPPTREQ.m

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDES2GETAPPTREQ   14176     printed  Feb 19, 2025@00:20:19                                                                                                                                                                                            Page 2

SDES2GETAPPTREQ ;ALB/BWF,JAS,BWF,JAS - SDES2 GET APPT REQ RPCS ; OCT 04, 2024

 +1       ;;5.3;Scheduling;**873,877,878,880,890,893**;Aug 13, 1993;Build 6

 +2       ;;Per VHA Directive 6402, this routine should not be modified

 +3       ;

 +4       ; Reference to ^VA(200 in ICR #10060 ;

 +5        QUIT 

 +6       ;

 +7       ; For an example of the return object, see SDES2GETREQWRAP due to its length.

 +8       ; If you add new components to the JSON return object here, document

 +9       ; in header of SDES2GETREQWRAP, initialize in APPTREQUEST.

 +10      ;

 +11      ; Input:

 +12      ; SDCONTEXT

 +13      ; SDINPUT("PATIENT IEN")=Patient DFN from the PATIENT file (#2)

 +14      ;

GETREQSBYDFN(JSONRETURN,SDCONTEXT,SDINPUT) ; SDES2 GET APPT REQ BY DFN

 +1        NEW VRET,ERRORS,REQUESTIEN,REQUEST,DFN,SDDUZ

 +2       ;

 +3        DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)

 +4        IF $DATA(ERRORS)

               SET ERRORS("Request",1)=""

               DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)

               QUIT 

 +5        DO VALFILEIEN^SDES2VALUTIL(.VRET,.ERRORS,2,$GET(SDINPUT("PATIENT IEN")),1,,1,2)

 +6        IF $DATA(ERRORS)

               SET ERRORS("Request",1)=""

               DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)

               QUIT 

 +7       ;

 +8        SET SDDUZ=$SELECT($GET(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)

 +9        SET DFN=$GET(SDINPUT("PATIENT IEN"))

 +10       SET REQUESTIEN=0

 +11       FOR 

               SET REQUESTIEN=$ORDER(^SDEC(409.85,"B",DFN,REQUESTIEN))

               if 'REQUESTIEN

                   QUIT 

               Begin DoDot:1

 +12               IF $$GET1^DIQ(409.85,REQUESTIEN,23,"I")="C"

                       QUIT 

 +13               DO GETREQUEST(.REQUEST,REQUESTIEN,SDDUZ)

               End DoDot:1

 +14       IF '$DATA(REQUEST)

               SET REQUEST("Request",1)=""

 +15       DO BUILDJSON^SDES2JSON(.JSONRETURN,.REQUEST)

 +16       QUIT 

 +17      ;

 +18      ; Input:

 +19      ; SDCONTEXT

 +20      ; SDINPUT("REQUEST IEN")=Request IEN from SDEC APPT REQUEST (#409.85)

 +21      ;

GETREQBYREQIEN(JSONRETURN,SDCONTEXT,SDINPUT) ;GET APPT REQ BY IEN

 +1        NEW ERRORS,REQUEST,SDDUZ

 +2       ;

 +3        DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)

 +4        IF $DATA(ERRORS)

               SET ERRORS("Request",1)=""

               DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)

               QUIT 

 +5        DO VALFILEIEN^SDES2VALUTIL(.VRET,.ERRORS,409.85,$GET(SDINPUT("REQUEST IEN")),1,,3,4)

 +6        IF $DATA(ERRORS)

               SET ERRORS("Request",1)=""

               DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)

               QUIT 

 +7       ;

 +8        SET SDDUZ=$SELECT($GET(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)

 +9        DO GETREQUEST(.REQUEST,$GET(SDINPUT("REQUEST IEN")),SDDUZ)

 +10       IF '$DATA(REQUEST)

               SET REQUEST("Request",1)=""

 +11       DO BUILDJSON^SDES2JSON(.JSONRETURN,.REQUEST)

 +12       QUIT 

 +13      ;

GETREQBYTYPEVET(JSONRETURN,SDCONTEXT,SDINPUT) ;GET APPT REQ BY TYPE VET

 +1        NEW ERRORS,REQUEST,COUNT,REQDATE,REQUESTIEN,SDDUZ

 +2        DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)

 +3        IF $DATA(ERRORS)

               SET ERRORS("Request",1)=""

               DO BUILDJSON^SDES2JSON(.JSONRETURN,.ERRORS)

               QUIT 

 +4        SET SDDUZ=$SELECT($GET(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)

 +5        SET COUNT=0

 +6        SET REQDATE=0

           FOR 

               SET REQDATE=$ORDER(^SDEC(409.85,"E","O",REQDATE))

               if 'REQDATE!(COUNT=200)

                   QUIT 

               Begin DoDot:1

 +7                SET REQUESTIEN=0

                   FOR 

                       SET REQUESTIEN=$ORDER(^SDEC(409.85,"E","O",REQDATE,REQUESTIEN))

                       if 'REQUESTIEN!(COUNT=200)

                           QUIT 

                       Begin DoDot:2

 +8                        IF '$DATA(^SDEC(409.85,"TYPE","VETERAN",REQUESTIEN))

                               QUIT 

 +9                        SET COUNT=COUNT+1

 +10                       DO GETREQUEST(.REQUEST,REQUESTIEN,SDDUZ)

                       End DoDot:2

               End DoDot:1

 +11       IF '$DATA(REQUEST)

               SET REQUEST("Request",1)=""

 +12       DO BUILDJSON^SDES2JSON(.JSONRETURN,.REQUEST)

 +13       QUIT 

 +14      ;

BUILDPATCOMMENTS(REQUEST,REQUESTIEN,NUM) ;

 +1        NEW SUBIEN,COUNT

 +2        SET SUBIEN=0

           SET COUNT=0

 +3        FOR 

               SET SUBIEN=$ORDER(^SDEC(409.85,REQUESTIEN,"PATCOM",SUBIEN))

               if 'SUBIEN

                   QUIT 

               Begin DoDot:1

 +4                SET COUNT=COUNT+1

 +5                SET REQUEST("Request",NUM,"PatientComment",COUNT,"Comment")=$$GET1^DIQ(409.855,SUBIEN_","_REQUESTIEN_",",.01,"E")

               End DoDot:1

 +6        QUIT 

 +7       ;

BUILDCOMMAUDIT(REQUEST,REQUESTIEN,NUM) ;Comments Audit Multiple (#27)

 +1        NEW SUBIEN,COUNT

 +2        SET SUBIEN=0

           SET COUNT=0

 +3        FOR 

               SET SUBIEN=$ORDER(^SDEC(409.85,REQUESTIEN,"COMAUD",SUBIEN))

               if 'SUBIEN

                   QUIT 

               Begin DoDot:1

 +4                SET COUNT=COUNT+1

 +5                SET REQUEST("Request",NUM,"CommentMultiple",COUNT,"DateCommAdded")=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.8527,SUBIEN_","_REQUESTIEN_",",.01,"I"))

 +6                SET REQUEST("Request",NUM,"CommentMultiple",COUNT,"CommAddedByDUZ")=$$GET1^DIQ(409.8527,SUBIEN_","_REQUESTIEN_",",1,"I")

 +7                SET REQUEST("Request",NUM,"CommentMultiple",COUNT,"CommAddedByName")=$$GET1^DIQ(409.8527,SUBIEN_","_REQUESTIEN_",",1,"E")

 +8                SET REQUEST("Request",NUM,"CommentMultiple",COUNT,"Comment")=$$GET1^DIQ(409.8527,SUBIEN_","_REQUESTIEN_",",2,"I")

               End DoDot:1

 +9        QUIT 

 +10      ;

BUILDMRTCPIDS(REQUEST,REQUESTIEN,NUM) ;MRTC PID entries

 +1        NEW SUBIEN,DATE,COUNT

 +2        SET SUBIEN=0

           SET COUNT=0

 +3        FOR 

               SET SUBIEN=$ORDER(^SDEC(409.85,REQUESTIEN,5,SUBIEN))

               if 'SUBIEN

                   QUIT 

               Begin DoDot:1

 +4                SET COUNT=COUNT+1

 +5                SET DATE=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.851,SUBIEN_","_REQUESTIEN_",",.01,"I"))

 +6                SET REQUEST("Request",NUM,"MRTC",COUNT,"PatientIndicatedDate")=DATE

               End DoDot:1

 +7        QUIT 

 +8       ;

BUILDMRTCS(REQUEST,REQUESTIEN,NUM) ;

 +1        NEW SUBIEN,COUNT,MIENS,CHILDIEN

 +2        SET SUBIEN=0

           SET COUNT=0

 +3        FOR 

               SET SUBIEN=$ORDER(^SDEC(409.85,REQUESTIEN,2,SUBIEN))

               if 'SUBIEN

                   QUIT 

               Begin DoDot:1

 +4                SET COUNT=COUNT+1

 +5                SET MIENS=SUBIEN_","_REQUESTIEN_","

 +6                SET CHILDIEN=$$GET1^DIQ(409.852,MIENS,.01,"I")

 +7                SET REQUEST("Request",NUM,"MRTC",COUNT,"ChildRequestIEN")=CHILDIEN

 +8                SET REQUEST("Request",NUM,"MRTC",COUNT,"LinkedAppointmentIEN")=$$GET1^DIQ(409.852,MIENS,.02,"I")

 +9                SET REQUEST("Request",NUM,"MRTC",COUNT,"ChildRequestSequenceNumber")=$$GET1^DIQ(409.85,CHILDIEN,43.1,"I")

               End DoDot:1

 +10       SET REQUEST("Request",NUM,"MRTCTotal")=COUNT

 +11       QUIT 

 +12      ;

BUILDSDECONTACT(REQUEST,REQUESTIEN,NUM,REQUESTTYPE) ;get consult/recall

 +1        NEW CONTACTIEN,SUBIEN,CIENS,COUNT,CONTARY,CONTACTYPE,CONTACTS,ERRORS

 +2        SET COUNT=0

           SET CONTACTIEN=0

 +3        SET CONTACTIEN=$$GETCONTIEN^SDESCONTACTS(.ERRORS,REQUESTIEN,REQUESTTYPE)

 +4        IF 'CONTACTIEN

               SET REQUEST("Request",NUM,"Contact",1)=""

               QUIT 

 +5        SET SUBIEN=$$GET1^DIQ(409.86,CONTACTIEN,2.2,"I")-1

 +6        FOR 

               SET SUBIEN=$ORDER(^SDEC(409.86,CONTACTIEN,1,SUBIEN))

               if 'SUBIEN

                   QUIT 

               Begin DoDot:1

 +7                SET CIENS=SUBIEN_","_CONTACTIEN_","

 +8                SET CONTACTYPE=$$GET1^DIQ(409.863,CIENS,1,"I")

 +9                IF $LENGTH($GET(CONTACTYPE))

                       Begin DoDot:2

 +10                       SET CONTARY(CONTACTYPE)=$GET(CONTARY(CONTACTYPE))+1

 +11                       SET COUNT=COUNT+1

 +12                       SET REQUEST("Request",NUM,"SdecContactNumberOfCalls")=$GET(CONTARY("C"))

 +13                       SET REQUEST("Request",NUM,"SdecContactNumberOfEmailContact")=$GET(CONTARY("E"))

 +14                       SET REQUEST("Request",NUM,"SdecContactNumberOfTextContact")=$GET(CONTARY("T"))

 +15                       SET REQUEST("Request",NUM,"SdecContactNumberOfSecureMessage")=$GET(CONTARY("S"))

 +16                       SET REQUEST("Request",NUM,"SdecContactNumberOfLetters")=$GET(CONTARY("L"))

 +17                       if ($GET(CONTACTYPE)="L")

                               SET REQUEST("Request",NUM,"SdecContactDateOfLastLetterSent")=$$FMTISO^SDAMUTDT($$GET1^DIQ(409.863,CIENS,.01,"I"))

                       End DoDot:2

 +18               if ('$DATA(REQUEST("Request",NUM,"SdecContactDateOfLastLetterSent")))

                       SET REQUEST("Request",NUM,"SdecContactDateOfLastLetterSent")=""

               End DoDot:1

 +19       SET REQUEST("Request",NUM,"SdecContactNumberOfContacts")=COUNT

 +20       DO BLDCONTACT^SDESCONTACTS(.CONTACTS,CONTACTIEN)

 +21       DO DISPMULT^SDESCONTACTS(.CONTACTS,CONTACTIEN)

 +22       IF $DATA(CONTACTS)

               MERGE REQUEST("Request",NUM)=CONTACTS

               QUIT 

 +23       IF '$DATA(CONTACTS)

               SET REQUEST("Request",NUM,"Contact",1)=""

 +24       QUIT 

BUILDCPRSPREREQS(REQUEST,REQUESTIEN,NUM) ;

 +1        NEW SUBIEN,COUNT,PIENS

 +2        SET SUBIEN=0

           SET COUNT=0

 +3        FOR 

               SET SUBIEN=$ORDER(^SDEC(409.85,REQUESTIEN,8,SUBIEN))

               if 'SUBIEN

                   QUIT 

               Begin DoDot:1

 +4                SET COUNT=COUNT+1

 +5                SET PIENS=SUBIEN_","_REQUESTIEN_","

 +6                SET REQUEST("Request",NUM,"CPRSPreRequisites",COUNT,"PreRequisite")=$$GET1^DIQ(409.8548,PIENS,.01,"E")

               End DoDot:1

 +7        QUIT 

 +8       ;

GETREQUEST(REQUEST,REQUESTIEN,SDDUZ) ;

 +1        NEW APPT,REQUESTARY,ERR,IENS,FN,REQDATA,NUM,CLINSTOPIEN,CLINCREDIEN,DFN,SENSITIVE,CONTACTIEN,PRIOGROUP

 +2        SET FN=409.85

           SET NUM=""

 +3        SET NUM=$ORDER(REQUEST("Request",NUM),-1)+1

 +4        SET IENS=REQUESTIEN_","

 +5        DO GETS^DIQ(FN,IENS,"**","IE","REQDATA","ERR")

 +6        if $DATA(ERR)

               QUIT 

 +7        SET SDDUZ=$SELECT($GET(SDDUZ)'="":SDDUZ,1:DUZ)

 +8       ; Check the AMIS Stop codes on clinic

 +9        SET CLINSTOPIEN=$SELECT(REQDATA(FN,REQUESTIEN_",",8.5,"I")'="":REQDATA(FN,REQUESTIEN_",",8.5,"I"),1:$$GET1^DIQ(44,REQDATA(FN,REQUESTIEN_",",8,"I")_",",8,"I"))

 +10       SET CLINCREDIEN=$SELECT(REQDATA(FN,REQUESTIEN_",",13.5,"I")'="":REQDATA(FN,REQUESTIEN_",",13.5,"I"),1:$$GET1^DIQ(44,REQDATA(FN,REQUESTIEN_",",8,"I")_",",2503,"I"))

 +11      ;

 +12       IF $DATA(^SDEC(409.85,REQUESTIEN,"PATCOM"))

               DO BUILDPATCOMMENTS(.REQUEST,REQUESTIEN,NUM)

 +13       IF '$DATA(^SDEC(409.85,REQUESTIEN,"PATCOM"))

               SET REQUEST("Request",NUM,"PatientComment",1)=""

 +14      ;

 +15       IF $DATA(^SDEC(409.85,REQUESTIEN,"COMAUD"))

               DO BUILDCOMMAUDIT(.REQUEST,REQUESTIEN,NUM)

 +16       IF '$DATA(^SDEC(409.85,REQUESTIEN,"COMAUD"))

               SET REQUEST("Request",NUM,"CommentMultiple",1)=""

 +17      ;

 +18       IF $DATA(^SDEC(409.85,REQUESTIEN,8))

               DO BUILDCPRSPREREQS(.REQUEST,REQUESTIEN,NUM)

 +19       IF '$DATA(^SDEC(409.85,REQUESTIEN,8))

               SET REQUEST("Request",NUM,"CPRSPreRequisites",1)=""

 +20      ;

 +21      ;MRTCs

           IF $DATA(^SDEC(409.85,REQUESTIEN,2))

               DO BUILDMRTCS(.REQUEST,REQUESTIEN,NUM)

 +22       IF '$DATA(^SDEC(409.85,REQUESTIEN,2))

               SET REQUEST("Request",NUM,"MRTC",1)=""

 +23      ;

 +24      ;MRTC PIDs

           IF $DATA(^SDEC(409.85,REQUESTIEN,5))

               DO BUILDMRTCPIDS(.REQUEST,REQUESTIEN,NUM)

 +25      ;

 +26       DO GETCONTACTIEN^SDES2CONTACTS(.CONTACTIEN,REQUESTIEN_";SDEC(409.85,")

 +27       DO BUILDSDECONTACT(.REQUEST,REQUESTIEN,NUM,"A")

 +28       IF 'CONTACTIEN

               DO SDECONTACT^SDES2GETREQS(.REQUEST,NUM)

 +29      ;

 +30       SET DFN=REQDATA(FN,REQUESTIEN_",",.01,"I")

 +31       SET PRIOGROUP=$$PRIORITY^DGENA(DFN)

 +32       IF PRIOGROUP

               SET PRIOGROUP="GROUP "_PRIOGROUP

 +33      ;

 +34       SET REQUEST("Request",NUM,"Type")="Appt Request"

 +35       SET REQUEST("Request",NUM,"PatientIEN")=DFN

 +36       SET REQUEST("Request",NUM,"PatientICN")=$$GETPATICN^SDESINPUTVALUTL(DFN)

 +37      ;

           SET REQUEST("Request",NUM,"PatientName")=REQDATA(FN,REQUESTIEN_",",.01,"E")