SDESGETAREQINST2 ;ALB/ANU - GET APPT REQ RPCS ;Oct 01, 2023@15:35
;;5.3;Scheduling;**861**;Aug 13, 1993;Build 17
;;Per VHA Directive 6402, this routine should not be modified
;
; Reference to ^VA(200 in ICR #10060
; Reference to $$GET1^DIQ in ICR #2056
Q
;
; For an example of the return object, see SDESGETREQWRAPPR due to its length.
; If you add new components to the JSON return object in this routine, document
; them in header of SDESGETREQWRAPPR and initialize them in APPTREQUEST.
;
GETREQSBYINST(JSONRETURN,INST,YEAR,EAS) ; SDES GET APPT REQ BY INST OPEN
N ISINSTVALID,ISEASVALID,RETURN,ERRORS,REQUESTIEN,REQUEST,REQUESTDT,COUNT,ISYRVALID
N RECALLCNT,SDNYEAR,RECALLDTTM,RECALLUSER,RECALLIEN,RECALLCLIN,RECALLDIV,RECALLINST,DFN,X,Y
N CONSULTIEN,SDNAM,SDI,CPRSSTATUS,CONSINST,CONSCNT,SDIYEAR
;
S ISINSTVALID=$$VALIDATEINST(.ERRORS,$G(INST))
S ISYRVALID=$$VALIDATEYEAR(.ERRORS,$G(YEAR))
S ISEASVALID=$$VALIDATEEAS(.ERRORS,$G(EAS))
I $D(ERRORS) M RETURN=ERRORS D BUILDJSON(.JSONRETURN,.RETURN) Q
;
; get appointment requests
S REQUESTIEN=0,COUNT=1,REQUESTDT=""
F S REQUESTIEN=$O(^SDEC(409.85,"C",INST,REQUESTIEN)) Q:'REQUESTIEN!(COUNT>100) D
.I $$GET1^DIQ(409.85,REQUESTIEN,23,"I")="C" Q
.S REQUESTDT=$$GET1^DIQ(409.85,REQUESTIEN,9.5,"I")
.I REQUESTDT="" Q
.I YEAR'=$$FMTE^XLFDT($E(REQUESTDT,1,3)_"0000") Q
.I COUNT=101 Q
.D GETREQUEST^SDESGETAPPTREQ(.REQUEST,REQUESTIEN)
.S COUNT=COUNT+1
;
; get recalls
S RECALLCNT=1
S SDNYEAR=0
S SDIYEAR=0
S X=YEAR+1 D ^%DT S SDNYEAR=Y
S X=YEAR D ^%DT S SDIYEAR=Y
S RECALLDTTM=Y F S RECALLDTTM=$O(^SD(403.5,"AC",RECALLDTTM)) Q:'RECALLDTTM!(RECALLDTTM>=SDNYEAR)!(RECALLCNT>100) D
.S RECALLUSER=0 F S RECALLUSER=$O(^SD(403.5,"AC",RECALLDTTM,RECALLUSER)) Q:'RECALLUSER D
..S RECALLIEN=0 F S RECALLIEN=$O(^SD(403.5,"AC",RECALLDTTM,RECALLUSER,RECALLIEN)) Q:'RECALLIEN 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
...I RECALLCNT=101 Q
...S DFN=$$GET1^DIQ(403.5,RECALLIEN,.01,"I")
...D GETRECALL^SDESGETRECALL(.REQUEST,RECALLIEN,DFN)
...S RECALLCNT=RECALLCNT+1
;
; get consults
S CONSCNT=1
S CONSULTIEN=0
S SDNAM=SDIYEAR F S SDNAM=$O(^GMR(123,"E",SDNAM)) Q:'SDNAM!(SDNAM>=SDNYEAR)!(CONSCNT>100) D
.S CONSULTIEN="" F S CONSULTIEN=$O(^GMR(123,"E",SDNAM,CONSULTIEN)) Q:CONSULTIEN="" D
..S CPRSSTATUS=$$GET1^DIQ(123,CONSULTIEN,8,"E")
..I CPRSSTATUS'="PENDING",CPRSSTATUS'="ACTIVE" Q
..S CONSINST=$$GET1^DIQ(123,CONSULTIEN,.05,"I")
..I INST,CONSINST,(CONSINST'=INST) Q
..I CONSCNT=101 Q
..D GETCONSULT^SDESGETCONSULTS(.REQUEST,CONSULTIEN)
..S CONSCNT=CONSCNT+1
;
I '$D(REQUEST) S REQUEST("Request",1)=""
M RETURN=REQUEST
;
D BUILDJSON(.JSONRETURN,.RETURN)
Q
;
VALIDATEINST(ERRORS,INST) ;
I INST="" D ERRLOG^SDESJSON(.ERRORS,409) Q 0
I INST'="",'$D(^DIC(4,INST,0)) D ERRLOG^SDESJSON(.ERRORS,410) Q 0
Q 1
;
VALIDATEYEAR(ERRORS,YEAR) ;
I YEAR="" D ERRLOG^SDESJSON(.ERRORS,411) Q 0
I YEAR>$$FMTE^XLFDT($E($$NOW^XLFDT,1,3)_"0000") D ERRLOG^SDESJSON(.ERRORS,412) Q 0
I +YEAR<1900 D ERRLOG^SDESJSON(.ERRORS,412) Q 0
Q 1
;
VALIDATEEAS(ERRORS,EAS) ;
I $L(EAS) S EAS=$$EASVALIDATE^SDESUTIL($G(EAS))
I $P($G(EAS),U)=-1 D ERRLOG^SDESJSON(.ERRORS,142) Q 0
Q 1
;
BUILDJSON(JSONRETURN,RETURN) ;
N JSONERROR
D ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERROR")
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESGETAREQINST2 3505 printed Nov 22, 2024@18:06:39 Page 2
SDESGETAREQINST2 ;ALB/ANU - GET APPT REQ RPCS ;Oct 01, 2023@15:35
+1 ;;5.3;Scheduling;**861**;Aug 13, 1993;Build 17
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Reference to ^VA(200 in ICR #10060
+5 ; Reference to $$GET1^DIQ in ICR #2056
+6 QUIT
+7 ;
+8 ; For an example of the return object, see SDESGETREQWRAPPR due to its length.
+9 ; If you add new components to the JSON return object in this routine, document
+10 ; them in header of SDESGETREQWRAPPR and initialize them in APPTREQUEST.
+11 ;
GETREQSBYINST(JSONRETURN,INST,YEAR,EAS) ; SDES GET APPT REQ BY INST OPEN
+1 NEW ISINSTVALID,ISEASVALID,RETURN,ERRORS,REQUESTIEN,REQUEST,REQUESTDT,COUNT,ISYRVALID
+2 NEW RECALLCNT,SDNYEAR,RECALLDTTM,RECALLUSER,RECALLIEN,RECALLCLIN,RECALLDIV,RECALLINST,DFN,X,Y
+3 NEW CONSULTIEN,SDNAM,SDI,CPRSSTATUS,CONSINST,CONSCNT,SDIYEAR
+4 ;
+5 SET ISINSTVALID=$$VALIDATEINST(.ERRORS,$GET(INST))
+6 SET ISYRVALID=$$VALIDATEYEAR(.ERRORS,$GET(YEAR))
+7 SET ISEASVALID=$$VALIDATEEAS(.ERRORS,$GET(EAS))
+8 IF $DATA(ERRORS)
MERGE RETURN=ERRORS
DO BUILDJSON(.JSONRETURN,.RETURN)
QUIT
+9 ;
+10 ; get appointment requests
+11 SET REQUESTIEN=0
SET COUNT=1
SET REQUESTDT=""
+12 FOR
SET REQUESTIEN=$ORDER(^SDEC(409.85,"C",INST,REQUESTIEN))
if 'REQUESTIEN!(COUNT>100)
QUIT
Begin DoDot:1
+13 IF $$GET1^DIQ(409.85,REQUESTIEN,23,"I")="C"
QUIT
+14 SET REQUESTDT=$$GET1^DIQ(409.85,REQUESTIEN,9.5,"I")
+15 IF REQUESTDT=""
QUIT
+16 IF YEAR'=$$FMTE^XLFDT($EXTRACT(REQUESTDT,1,3)_"0000")
QUIT
+17 IF COUNT=101
QUIT
+18 DO GETREQUEST^SDESGETAPPTREQ(.REQUEST,REQUESTIEN)
+19 SET COUNT=COUNT+1
End DoDot:1
+20 ;
+21 ; get recalls
+22 SET RECALLCNT=1
+23 SET SDNYEAR=0
+24 SET SDIYEAR=0
+25 SET X=YEAR+1
DO ^%DT
SET SDNYEAR=Y
+26 SET X=YEAR
DO ^%DT
SET SDIYEAR=Y
+27 SET RECALLDTTM=Y
FOR
SET RECALLDTTM=$ORDER(^SD(403.5,"AC",RECALLDTTM))
if 'RECALLDTTM!(RECALLDTTM>=SDNYEAR)!(RECALLCNT>100)
QUIT
Begin DoDot:1
+28 SET RECALLUSER=0
FOR
SET RECALLUSER=$ORDER(^SD(403.5,"AC",RECALLDTTM,RECALLUSER))
if 'RECALLUSER
QUIT
Begin DoDot:2
+29 SET RECALLIEN=0
FOR
SET RECALLIEN=$ORDER(^SD(403.5,"AC",RECALLDTTM,RECALLUSER,RECALLIEN))
if 'RECALLIEN
QUIT
Begin DoDot:3
+30 SET RECALLCLIN=$$GET1^DIQ(403.5,RECALLIEN,4.5,"I")
+31 SET RECALLDIV=$$GET1^DIQ(44,RECALLCLIN,3.5,"I")
+32 SET RECALLINST=$$GET1^DIQ(40.8,RECALLDIV,.07,"I")
+33 IF INST
IF INST'=RECALLINST
QUIT
+34 IF RECALLCNT=101
QUIT
+35 SET DFN=$$GET1^DIQ(403.5,RECALLIEN,.01,"I")
+36 DO GETRECALL^SDESGETRECALL(.REQUEST,RECALLIEN,DFN)
+37 SET RECALLCNT=RECALLCNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+38 ;
+39 ; get consults
+40 SET CONSCNT=1
+41 SET CONSULTIEN=0
+42 SET SDNAM=SDIYEAR
FOR
SET SDNAM=$ORDER(^GMR(123,"E",SDNAM))
if 'SDNAM!(SDNAM>=SDNYEAR)!(CONSCNT>100)
QUIT
Begin DoDot:1
+43 SET CONSULTIEN=""
FOR
SET CONSULTIEN=$ORDER(^GMR(123,"E",SDNAM,CONSULTIEN))
if CONSULTIEN=""
QUIT
Begin DoDot:2
+44 SET CPRSSTATUS=$$GET1^DIQ(123,CONSULTIEN,8,"E")
+45 IF CPRSSTATUS'="PENDING"
IF CPRSSTATUS'="ACTIVE"
QUIT
+46 SET CONSINST=$$GET1^DIQ(123,CONSULTIEN,.05,"I")
+47 IF INST
IF CONSINST
IF (CONSINST'=INST)
QUIT
+48 IF CONSCNT=101
QUIT
+49 DO GETCONSULT^SDESGETCONSULTS(.REQUEST,CONSULTIEN)
+50 SET CONSCNT=CONSCNT+1
End DoDot:2
End DoDot:1
+51 ;
+52 IF '$DATA(REQUEST)
SET REQUEST("Request",1)=""
+53 MERGE RETURN=REQUEST
+54 ;
+55 DO BUILDJSON(.JSONRETURN,.RETURN)
+56 QUIT
+57 ;
VALIDATEINST(ERRORS,INST) ;
+1 IF INST=""
DO ERRLOG^SDESJSON(.ERRORS,409)
QUIT 0
+2 IF INST'=""
IF '$DATA(^DIC(4,INST,0))
DO ERRLOG^SDESJSON(.ERRORS,410)
QUIT 0
+3 QUIT 1
+4 ;
VALIDATEYEAR(ERRORS,YEAR) ;
+1 IF YEAR=""
DO ERRLOG^SDESJSON(.ERRORS,411)
QUIT 0
+2 IF YEAR>$$FMTE^XLFDT($EXTRACT($$NOW^XLFDT,1,3)_"0000")
DO ERRLOG^SDESJSON(.ERRORS,412)
QUIT 0
+3 IF +YEAR<1900
DO ERRLOG^SDESJSON(.ERRORS,412)
QUIT 0
+4 QUIT 1
+5 ;
VALIDATEEAS(ERRORS,EAS) ;
+1 IF $LENGTH(EAS)
SET EAS=$$EASVALIDATE^SDESUTIL($GET(EAS))
+2 IF $PIECE($GET(EAS),U)=-1
DO ERRLOG^SDESJSON(.ERRORS,142)
QUIT 0
+3 QUIT 1
+4 ;
BUILDJSON(JSONRETURN,RETURN) ;
+1 NEW JSONERROR
+2 DO ENCODE^XLFJSON("RETURN","JSONRETURN","JSONERROR")
+3 ;
+4 QUIT
