Routine: SDES2GREQSINST

SDES2GREQSINST ;ALB/BWF - SDES2 get all appointment requests by institution ;JUL 18, 2023

 ;;5.3;Scheduling;**853,877**;Aug 13, 1993;Build 14

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

 ; INPUT

 ; SDCONTEXT Array

 ; SDAPPTREQS("STATION NUMBER") - (optional) - Institution Station Number

 ; SDAPPTREQS("NUMBER")         - (optional) - the number of records to find for each appointment request type

 ;                                             consult/procedure, appointment request, and recall.

GETREQUESTS(RESULTS,SDCONTEXT,SDAPPTREQS) ;

 N CONSIEN,CPRSSTAT,CONSTATACTIVE,CONSCNT,CONSDTTM,NUMRECORDS,CONSTATPENDING,APPTREQIEN,RECALLDTTM,RECALLIEN,REQUEST,RECALLCNT

 N DFN,RECALLUSER,RECALLIEN,RECALLPTR,CONSPTR,APPTREQCNT,APPTREQDTTM,APPTREQIEN,APPTREQPTR,DATELOOP,IENLOOP

 N RECORDIEN,RECORDPTR,GMRCNT,ERRORS,APPTREQENTERED,STAT,INST,CONSINST,RECALLCLIN,RECALLDIV,RECALLINST,STATION,VALSTAT,SDDUZ

 K ^TMP("SDES2GREQSINST",$J)

 ; validate context array

 D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)

 I $D(ERRORS) S ERRORS("Request",1)="" D BUILDJSON^SDES2JSON(.RESULTS,.ERRORS) Q

 S SDDUZ=$S($G(SDCONTEXT("USER DUZ"))'="":SDCONTEXT("USER DUZ"),1:DUZ)

 ; validate input array

 S STATION=$G(SDAPPTREQS("STATION NUMBER"))

 S INST=$$IEN^XUAF4(STATION)

 I STATION]"",'INST D ERRLOG^SDES2JSON(.ERRORS,197)

 S NUMRECORDS=$G(SDAPPTREQS("NUMBER"))

 I NUMRECORDS D VALNUMBERRNG^SDES2VALUTIL(.VALSTAT,.ERRORS,NUMRECORDS,1,200,,,504)

 I $D(ERRORS) S ERRORS("Request",1)="" D BUILDJSON^SDES2JSON(.RESULTS,.ERRORS) Q

 I 'NUMRECORDS S NUMRECORDS=200

 ; get the consults

 S CONSTATACTIVE=$O(^ORD(100.01,"B","ACTIVE",0))

 S CONSTATPENDING=$O(^ORD(100.01,"B","PENDING",0))

 F STAT=CONSTATACTIVE,CONSTATPENDING D

 .; set CONSCNT here so we get at least NUMRECORDS for each status, allowing us to get a mixture from both pending and active status

 .S (CONSIEN,CONSCNT)=0

 .F  S CONSIEN=$O(^GMR(123,"D",STAT,CONSIEN)) Q:'CONSIEN!(CONSCNT>NUMRECORDS)  D

 ..S CONSDTTM=$$GET1^DIQ(123,CONSIEN,.01,"I")

 ..S CONSINST=$$GET1^DIQ(123,CONSIEN,.05,"I")

 ..I INST,CONSINST,(CONSINST'=INST) Q

 ..S CONSCNT=CONSCNT+1

 ..S CONSPTR=CONSIEN_";GMR(123,"

 ..S ^TMP("SDES2GREQSINST",$J,CONSDTTM,CONSPTR)=""

 ; get recalls

 S RECALLCNT=0

 S RECALLDTTM=0 F  S RECALLDTTM=$O(^SD(403.5,"AC",RECALLDTTM)) Q:'RECALLDTTM!(RECALLCNT=NUMRECORDS)!(RECALLCNT>NUMRECORDS)  D

 .S RECALLUSER=0 F  S RECALLUSER=$O(^SD(403.5,"AC",RECALLDTTM,RECALLUSER)) Q:'RECALLUSER!(RECALLCNT=NUMRECORDS)!(RECALLCNT>NUMRECORDS)  D

 ..S RECALLIEN=0 F  S RECALLIEN=$O(^SD(403.5,"AC",RECALLDTTM,RECALLUSER,RECALLIEN)) Q:'RECALLIEN!(RECALLCNT>NUMRECORDS)  D

 ...S RECALLCLIN=$$GET1^DIQ(403.5,RECALLIEN,4.5,"I")

 ...S RECALLDIV=$$GET1^DIQ(44,RECALLCLIN,3.5,"I")

 ...S RECALLINST=$$GET1^DIQ(40.8,RECALLDIV,.07,"I")

 ...I INST,INST'=RECALLINST Q

 ...S RECALLCNT=RECALLCNT+1

 ...S RECALLPTR=RECALLIEN_";SD(403.5,"

 ...S ^TMP("SDES2GREQSINST",$J,RECALLDTTM,RECALLPTR)=""

 ; get appointment requests

 S APPTREQCNT=0

 S APPTREQDTTM=0 F  S APPTREQDTTM=$O(^SDEC(409.85,"E","O",APPTREQDTTM)) Q:'APPTREQDTTM!(APPTREQCNT=NUMRECORDS)!(APPTREQCNT>NUMRECORDS)  D

 .S APPTREQIEN=0 F  S APPTREQIEN=$O(^SDEC(409.85,"E","O",APPTREQDTTM,APPTREQIEN)) Q:'APPTREQIEN!(APPTREQCNT=NUMRECORDS)!(APPTREQCNT>NUMRECORDS)  D

 ..S APPTREQENTERED=$$GET1^DIQ(409.85,APPTREQIEN,9.5,"I")

 ..I INST,INST'=$$GET1^DIQ(409.85,APPTREQIEN,2,"I") Q

 ..S APPTREQCNT=APPTREQCNT+1

 ..S APPTREQPTR=APPTREQIEN_";SDEC(409.85,"

 ..S ^TMP("SDES2GREQSINST",$J,APPTREQENTERED,APPTREQPTR)=""

 ; process results in ^TMP

 S GMRCNT=0

 S DATELOOP=0 F  S DATELOOP=$O(^TMP("SDES2GREQSINST",$J,DATELOOP)) Q:'DATELOOP  D

 .S IENLOOP="" F  S IENLOOP=$O(^TMP("SDES2GREQSINST",$J,DATELOOP,IENLOOP)) Q:IENLOOP=""  D

 ..S RECORDIEN=$P(IENLOOP,";")

 ..S RECORDPTR=$P(IENLOOP,";",2)

 ..I RECORDPTR["GMR(123" D  Q

 ...Q:GMRCNT=NUMRECORDS!(GMRCNT>NUMRECORDS)

 ...S GMRCNT=GMRCNT+1

 ...D GETCONSULT^SDES2GETCONSULTS(.REQUEST,RECORDIEN,SDDUZ)

 ..I RECORDPTR["SD(403.5" D  Q

 ...D GETRECALL^SDES2GETRECALL(.REQUEST,RECORDIEN,$$GET1^DIQ(403.5,RECORDIEN,.01,"I"),SDDUZ)

 ..I RECORDPTR["SDEC(409.85" D  Q

 ...D GETREQUEST^SDES2GETAPPTREQ(.REQUEST,RECORDIEN,SDDUZ)

 I '$D(REQUEST) S REQUEST("Request",1)="" D BUILDJSON^SDES2JSON(.RESULTS,.REQUEST) K ^TMP("SDES2GREQSINST",$J) Q

 D BUILDJSON^SDES2JSON(.RESULTS,.REQUEST)

 K ^TMP("SDES2GREQSINST",$J)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2GREQSINST   4431     printed  Mar 13, 2025@21:59:25                                                                                                                                                                                              Page 2

SDES2GREQSINST ;ALB/BWF - SDES2 get all appointment requests by institution ;JUL 18, 2023

 +1       ;;5.3;Scheduling;**853,877**;Aug 13, 1993;Build 14

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

 +3       ;

 +4        QUIT

 +5       ;

 +6       ; INPUT

 +7       ;

 +8       ; SDCONTEXT Array

 +9       ;

 +10      ; SDAPPTREQS("STATION NUMBER") - (optional) - Institution Station Number

 +11      ; SDAPPTREQS("NUMBER")         - (optional) - the number of records to find for each appointment request type

 +12      ;                                             consult/procedure, appointment request, and recall.

 +13      ;

GETREQUESTS(RESULTS,SDCONTEXT,SDAPPTREQS) ;

 +1        NEW CONSIEN,CPRSSTAT,CONSTATACTIVE,CONSCNT,CONSDTTM,NUMRECORDS,CONSTATPENDING,APPTREQIEN,RECALLDTTM,RECALLIEN,REQUEST,RECALLCNT

 +2        NEW DFN,RECALLUSER,RECALLIEN,RECALLPTR,CONSPTR,APPTREQCNT,APPTREQDTTM,APPTREQIEN,APPTREQPTR,DATELOOP,IENLOOP

 +3        NEW RECORDIEN,RECORDPTR,GMRCNT,ERRORS,APPTREQENTERED,STAT,INST,CONSINST,RECALLCLIN,RECALLDIV,RECALLINST,STATION,VALSTAT,SDDUZ

 +4        KILL ^TMP("SDES2GREQSINST",$JOB)

 +5       ; validate context array

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

 +7        IF $DATA(ERRORS)

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

               DO BUILDJSON^SDES2JSON(.RESULTS,.ERRORS)

               QUIT

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

 +9       ; validate input array

 +10       SET STATION=$GET(SDAPPTREQS("STATION NUMBER"))

 +11       SET INST=$$IEN^XUAF4(STATION)

 +12       IF STATION]""

               IF 'INST

                   DO ERRLOG^SDES2JSON(.ERRORS,197)

 +13       SET NUMRECORDS=$GET(SDAPPTREQS("NUMBER"))

 +14       IF NUMRECORDS

               DO VALNUMBERRNG^SDES2VALUTIL(.VALSTAT,.ERRORS,NUMRECORDS,1,200,,,504)

 +15       IF $DATA(ERRORS)

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

               DO BUILDJSON^SDES2JSON(.RESULTS,.ERRORS)

               QUIT

 +16       IF 'NUMRECORDS

               SET NUMRECORDS=200

 +17      ; get the consults

 +18       SET CONSTATACTIVE=$ORDER(^ORD(100.01,"B","ACTIVE",0))

 +19       SET CONSTATPENDING=$ORDER(^ORD(100.01,"B","PENDING",0))

 +20       FOR STAT=CONSTATACTIVE,CONSTATPENDING

               Begin DoDot:1

 +21      ; set CONSCNT here so we get at least NUMRECORDS for each status, allowing us to get a mixture from both pending and active status

 +22               SET (CONSIEN,CONSCNT)=0

 +23               FOR

                       SET CONSIEN=$ORDER(^GMR(123,"D",STAT,CONSIEN))

                       if 'CONSIEN!(CONSCNT>NUMRECORDS)

                           QUIT

                       Begin DoDot:2

 +24                       SET CONSDTTM=$$GET1^DIQ(123,CONSIEN,.01,"I")

 +25                       SET CONSINST=$$GET1^DIQ(123,CONSIEN,.05,"I")

 +26                       IF INST

                               IF CONSINST

                                   IF (CONSINST'=INST)

                                       QUIT

 +27                       SET CONSCNT=CONSCNT+1

 +28                       SET CONSPTR=CONSIEN_";GMR(123,"

 +29                       SET ^TMP("SDES2GREQSINST",$JOB,CONSDTTM,CONSPTR)=""

                       End DoDot:2

               End DoDot:1

 +30      ; get recalls

 +31       SET RECALLCNT=0

 +32       SET RECALLDTTM=0

FOR

               SET RECALLDTTM=$ORDER(^SD(403.5,"AC",RECALLDTTM))

               if 'RECALLDTTM!(RECALLCNT=NUMRECORDS)!(RECALLCNT>NUMRECORDS)

                   QUIT

               Begin DoDot:1

 +33               SET RECALLUSER=0

FOR

                       SET RECALLUSER=$ORDER(^SD(403.5,"AC",RECALLDTTM,RECALLUSER))

                       if 'RECALLUSER!(RECALLCNT=NUMRECORDS)!(RECALLCNT>NUMRECORDS)

                           QUIT

                       Begin DoDot:2

 +34                       SET RECALLIEN=0

FOR

                               SET RECALLIEN=$ORDER(^SD(403.5,"AC",RECALLDTTM,RECALLUSER,RECALLIEN))

                               if 'RECALLIEN!(RECALLCNT>NUMRECORDS)

                                   QUIT

                               Begin DoDot:3

 +35                               SET RECALLCLIN=$$GET1^DIQ(403.5,RECALLIEN,4.5,"I")

 +36                               SET RECALLDIV=$$GET1^DIQ(44,RECALLCLIN,3.5,"I")

 +37                               SET RECALLINST=$$GET1^DIQ(40.8,RECALLDIV,.07,"I")

 +38                               IF INST

                                       IF INST'=RECALLINST

                                           QUIT

 +39                               SET RECALLCNT=RECALLCNT+1

 +40                               SET RECALLPTR=RECALLIEN_";SD(403.5,"

 +41                               SET ^TMP("SDES2GREQSINST",$JOB,RECALLDTTM,RECALLPTR)=""

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +42      ; get appointment requests

 +43       SET APPTREQCNT=0

 +44       SET APPTREQDTTM=0

FOR

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

               if 'APPTREQDTTM!(APPTREQCNT=NUMRECORDS)!(APPTREQCNT>NUMRECORDS)

                   QUIT

               Begin DoDot:1

 +45               SET APPTREQIEN=0

FOR

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

                       if 'APPTREQIEN!(APPTREQCNT=NUMRECORDS)!(APPTREQCNT>NUMRECORDS)

                           QUIT

                       Begin DoDot:2

 +46                       SET APPTREQENTERED=$$GET1^DIQ(409.85,APPTREQIEN,9.5,"I")

 +47                       IF INST

                               IF INST'=$$GET1^DIQ(409.85,APPTREQIEN,2,"I")

                                   QUIT

 +48                       SET APPTREQCNT=APPTREQCNT+1

 +49                       SET APPTREQPTR=APPTREQIEN_";SDEC(409.85,"

 +50                       SET ^TMP("SDES2GREQSINST",$JOB,APPTREQENTERED,APPTREQPTR)=""

                       End DoDot:2

               End DoDot:1

 +51      ; process results in ^TMP

 +52       SET GMRCNT=0

 +53       SET DATELOOP=0

FOR

               SET DATELOOP=$ORDER(^TMP("SDES2GREQSINST",$JOB,DATELOOP))

               if 'DATELOOP

                   QUIT

               Begin DoDot:1

 +54               SET IENLOOP=""

FOR

                       SET IENLOOP=$ORDER(^TMP("SDES2GREQSINST",$JOB,DATELOOP,IENLOOP))

                       if IENLOOP=""

                           QUIT

                       Begin DoDot:2

 +55                       SET RECORDIEN=$PIECE(IENLOOP,";")

 +56                       SET RECORDPTR=$PIECE(IENLOOP,";",2)

 +57                       IF RECORDPTR["GMR(123"

                               Begin DoDot:3

 +58                               if GMRCNT=NUMRECORDS!(GMRCNT>NUMRECORDS)

                                       QUIT

 +59                               SET GMRCNT=GMRCNT+1

 +60                               DO GETCONSULT^SDES2GETCONSULTS(.REQUEST,RECORDIEN,SDDUZ)

                               End DoDot:3

                               QUIT

 +61                       IF RECORDPTR["SD(403.5"

                               Begin DoDot:3

 +62                               DO GETRECALL^SDES2GETRECALL(.REQUEST,RECORDIEN,$$GET1^DIQ(403.5,RECORDIEN,.01,"I"),SDDUZ)

                               End DoDot:3

                               QUIT

 +63                       IF RECORDPTR["SDEC(409.85"

                               Begin DoDot:3

 +64                               DO GETREQUEST^SDES2GETAPPTREQ(.REQUEST,RECORDIEN,SDDUZ)

                               End DoDot:3

                               QUIT

                       End DoDot:2

               End DoDot:1

 +65       IF '$DATA(REQUEST)

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

               DO BUILDJSON^SDES2JSON(.RESULTS,.REQUEST)

               KILL ^TMP("SDES2GREQSINST",$JOB)

               QUIT

 +66       DO BUILDJSON^SDES2JSON(.RESULTS,.REQUEST)

 +67       KILL ^TMP("SDES2GREQSINST",$JOB)

 +68       QUIT

SDES2GREQSINST.m