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
;
Q
;
; 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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2GREQSINST 4431 printed Nov 22, 2024@18:04:17 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
