SDES2GREQSINST ;ALB/BWF - SDES2 get all appointment requests by institution ;JUL 18, 2023
;;5.3;Scheduling;**853**;Aug 13, 1993;Build 9
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
; INPUT
;
; SDCONTEXT("ACHERON AUDIT ID") = 36 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
; SDCONTEXT("USER DUZ") = The DUZ of the user taking action on the calling application.
; SDCONTEXT("USER NAME") = The name of the user taking action on the calling application.
; SDCONTEXT("PATIENT DFN") = The name of the patient taking action on the calling application.
; SDCONTEXT("PATIENT ICN") = The ICN of the patient taking action on the calling application.
;
; 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
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
; 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^SDESGETCONSULTS(.REQUEST,RECORDIEN)
..I RECORDPTR["SD(403.5" D Q
...D GETRECALL^SDESGETRECALL(.REQUEST,RECORDIEN,$$GET1^DIQ(403.5,RECORDIEN,.01,"I"))
..I RECORDPTR["SDEC(409.85" D Q
...D GETREQUEST^SDESGETAPPTREQ(.REQUEST,RECORDIEN)
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 4790 printed Apr 09, 2024@21:57:33 Page 2
SDES2GREQSINST ;ALB/BWF - SDES2 get all appointment requests by institution ;JUL 18, 2023
+1 ;;5.3;Scheduling;**853**;Aug 13, 1993;Build 9
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
+6 ; INPUT
+7 ;
+8 ; SDCONTEXT("ACHERON AUDIT ID") = 36 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
+9 ; SDCONTEXT("USER DUZ") = The DUZ of the user taking action on the calling application.
+10 ; SDCONTEXT("USER NAME") = The name of the user taking action on the calling application.
+11 ; SDCONTEXT("PATIENT DFN") = The name of the patient taking action on the calling application.
+12 ; SDCONTEXT("PATIENT ICN") = The ICN of the patient taking action on the calling application.
+13 ;
+14 ; SDAPPTREQS("STATION NUMBER") - (optional) - Institution Station Number
+15 ; SDAPPTREQS("NUMBER") - (optional) - the number of records to find for each appointment request type
+16 ; consult/procedure, appointment request, and recall.
+17 ;
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
+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 ; validate input array
+9 SET STATION=$GET(SDAPPTREQS("STATION NUMBER"))
+10 SET INST=$$IEN^XUAF4(STATION)
+11 IF STATION]""
IF 'INST
DO ERRLOG^SDES2JSON(.ERRORS,197)
+12 SET NUMRECORDS=$GET(SDAPPTREQS("NUMBER"))
+13 IF NUMRECORDS
DO VALNUMBERRNG^SDES2VALUTIL(.VALSTAT,.ERRORS,NUMRECORDS,1,200,,,504)
+14 IF $DATA(ERRORS)
SET ERRORS("Request",1)=""
DO BUILDJSON^SDES2JSON(.RESULTS,.ERRORS)
QUIT
+15 IF 'NUMRECORDS
SET NUMRECORDS=200
+16 ; get the consults
+17 SET CONSTATACTIVE=$ORDER(^ORD(100.01,"B","ACTIVE",0))
+18 SET CONSTATPENDING=$ORDER(^ORD(100.01,"B","PENDING",0))
+19 FOR STAT=CONSTATACTIVE,CONSTATPENDING
Begin DoDot:1
+20 ; set CONSCNT here so we get at least NUMRECORDS for each status, allowing us to get a mixture from both pending and active status
+21 SET (CONSIEN,CONSCNT)=0
+22 FOR
SET CONSIEN=$ORDER(^GMR(123,"D",STAT,CONSIEN))
if 'CONSIEN!(CONSCNT>NUMRECORDS)
QUIT
Begin DoDot:2
+23 SET CONSDTTM=$$GET1^DIQ(123,CONSIEN,.01,"I")
+24 SET CONSINST=$$GET1^DIQ(123,CONSIEN,.05,"I")
+25 IF INST
IF CONSINST
IF (CONSINST'=INST)
QUIT
+26 SET CONSCNT=CONSCNT+1
+27 SET CONSPTR=CONSIEN_";GMR(123,"
+28 SET ^TMP("SDES2GREQSINST",$JOB,CONSDTTM,CONSPTR)=""
End DoDot:2
End DoDot:1
+29 ; get recalls
+30 SET RECALLCNT=0
+31 SET RECALLDTTM=0
FOR
SET RECALLDTTM=$ORDER(^SD(403.5,"AC",RECALLDTTM))
if 'RECALLDTTM!(RECALLCNT=NUMRECORDS)!(RECALLCNT>NUMRECORDS)
QUIT
Begin DoDot:1
+32 SET RECALLUSER=0
FOR
SET RECALLUSER=$ORDER(^SD(403.5,"AC",RECALLDTTM,RECALLUSER))
if 'RECALLUSER!(RECALLCNT=NUMRECORDS)!(RECALLCNT>NUMRECORDS)
QUIT
Begin DoDot:2
+33 SET RECALLIEN=0
FOR
SET RECALLIEN=$ORDER(^SD(403.5,"AC",RECALLDTTM,RECALLUSER,RECALLIEN))
if 'RECALLIEN!(RECALLCNT>NUMRECORDS)
QUIT
Begin DoDot:3
+34 SET RECALLCLIN=$$GET1^DIQ(403.5,RECALLIEN,4.5,"I")
+35 SET RECALLDIV=$$GET1^DIQ(44,RECALLCLIN,3.5,"I")
+36 SET RECALLINST=$$GET1^DIQ(40.8,RECALLDIV,.07,"I")
+37 IF INST
IF INST'=RECALLINST
QUIT
+38 SET RECALLCNT=RECALLCNT+1
+39 SET RECALLPTR=RECALLIEN_";SD(403.5,"
+40 SET ^TMP("SDES2GREQSINST",$JOB,RECALLDTTM,RECALLPTR)=""
End DoDot:3
End DoDot:2
End DoDot:1
+41 ; get appointment requests
+42 SET APPTREQCNT=0
+43 SET APPTREQDTTM=0
FOR
SET APPTREQDTTM=$ORDER(^SDEC(409.85,"E","O",APPTREQDTTM))
if 'APPTREQDTTM!(APPTREQCNT=NUMRECORDS)!(APPTREQCNT>NUMRECORDS)
QUIT
Begin DoDot:1
+44 SET APPTREQIEN=0
FOR
SET APPTREQIEN=$ORDER(^SDEC(409.85,"E","O",APPTREQDTTM,APPTREQIEN))
if 'APPTREQIEN!(APPTREQCNT=NUMRECORDS)!(APPTREQCNT>NUMRECORDS)
QUIT
Begin DoDot:2
+45 SET APPTREQENTERED=$$GET1^DIQ(409.85,APPTREQIEN,9.5,"I")
+46 IF INST
IF INST'=$$GET1^DIQ(409.85,APPTREQIEN,2,"I")
QUIT
+47 SET APPTREQCNT=APPTREQCNT+1
+48 SET APPTREQPTR=APPTREQIEN_";SDEC(409.85,"
+49 SET ^TMP("SDES2GREQSINST",$JOB,APPTREQENTERED,APPTREQPTR)=""
End DoDot:2
End DoDot:1
+50 ; process results in ^TMP
+51 SET GMRCNT=0
+52 SET DATELOOP=0
FOR
SET DATELOOP=$ORDER(^TMP("SDES2GREQSINST",$JOB,DATELOOP))
if 'DATELOOP
QUIT
Begin DoDot:1
+53 SET IENLOOP=""
FOR
SET IENLOOP=$ORDER(^TMP("SDES2GREQSINST",$JOB,DATELOOP,IENLOOP))
if IENLOOP=""
QUIT
Begin DoDot:2
+54 SET RECORDIEN=$PIECE(IENLOOP,";")
+55 SET RECORDPTR=$PIECE(IENLOOP,";",2)
+56 IF RECORDPTR["GMR(123"
Begin DoDot:3
+57 if GMRCNT=NUMRECORDS!(GMRCNT>NUMRECORDS)
QUIT
+58 SET GMRCNT=GMRCNT+1
+59 DO GETCONSULT^SDESGETCONSULTS(.REQUEST,RECORDIEN)
End DoDot:3
QUIT
+60 IF RECORDPTR["SD(403.5"
Begin DoDot:3
+61 DO GETRECALL^SDESGETRECALL(.REQUEST,RECORDIEN,$$GET1^DIQ(403.5,RECORDIEN,.01,"I"))
End DoDot:3
QUIT
+62 IF RECORDPTR["SDEC(409.85"
Begin DoDot:3
+63 DO GETREQUEST^SDESGETAPPTREQ(.REQUEST,RECORDIEN)
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+64 IF '$DATA(REQUEST)
SET REQUEST("Request",1)=""
DO BUILDJSON^SDES2JSON(.RESULTS,.REQUEST)
KILL ^TMP("SDES2GREQSINST",$JOB)
QUIT
+65 DO BUILDJSON^SDES2JSON(.RESULTS,.REQUEST)
+66 KILL ^TMP("SDES2GREQSINST",$JOB)
+67 QUIT
