SDEC51B ;ALB/LAB,ANU - VISTA SCHEDULING RPCS ;APR 12, 2021@14:39
;;5.3;Scheduling;**784,785**;Aug 13, 1993;Build 14
;
; Documented API's and Integration Agreements
; -------------------------------------------
; Reference to ^GMR(123 In ICR #4837
; Reference to ^GMR(123.5 In ICR #4557
; Reference to ^GMR(123 In ICR #6185
; Reference to ^ORD(100.01 In ICR #2638
; Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056
Q
;
CONSLIST(SDECY,DFN) ;Return a list of ACTIVE or PENDING CONSULTS for patient
;INPUT - DFN (Date File Number) Pointer to PATIENT (#2) File.
;RETURN PARMETER:
; List of consults in ACTIVE or PENDING CPRS STATUS. Data is delimited by
; carat (^).
; Field List:
; (1) Internal IEN
; (2) Request Type
; (3) File Entry Date
; (4) To Service/Specialty
; (5) Clinic IEN
; (6) Clinic Name
; (7) Date of Request
; (8) URGENCY name or Earliest date
; (9) Provider IEN
; (10) Provider Name
; (11) Service Rendered as in or outpatient
; (12) Associated Stop Code
; (13) Prohibited Clinic Flag
; (14) Clinic indicated Date
; (15) # of Phone contacts
; (16) Date of Last Letter
; (17) Covid Priority
;
N ACTIVE,PENDING,ERRPOP,ERRMSG,SDECI,SDTMP
S SDECI=$G(SDECI,0)
D INIT
D VALIDATE
I ERRPOP D ERR1^SDECERR(-1,ERRMSG,.SDECI,SDECY) Q
D SELCONS ;select "open" consults
D EXIT
Q
;
INIT ;
K ^TMP("SDEC51B",$J)
S SDECY="^TMP(""SDEC51B"","_$J_")"
S ACTIVE=$O(^ORD(100.01,"B","ACTIVE",0))
S PENDING=$O(^ORD(100.01,"B","PENDING",0))
S ERRPOP=0,SDECI=0,ERRMSG=""
; data header
D HDR
Q
;
VALIDATE ;
;*Add validation of DFN
I '(+DFN) D Q
.;create error message - DFN required
.S ERRMSG="DFN required. "
.S ERRPOP=1
I '$D(^DPT(DFN,0)) D
.;create error - Invalid DFN
.S ERRMSG="Invalid DFN"
.S ERRPOP=1
Q
;
HDR ;Get the header information
;
; Consult IEN^Request Type^ORIGDT^TO Service^CLINIEN^CLINNAME^Date of Request
; Prio^Provider IEN^Provider Name^Service Rendered As
; Req_Proc_Act^Stop^PRHBLOC^Earliest
; CPHONE^CLET^Covid_Priority
; 1 2 3 4
S SDTMP="T00020CONSULTIEN^T00020REQTYPE^T00020ORIGDT^T00030TO_SERVICE"
; 5 6 7 8
S SDTMP=SDTMP_"^T00010CLINIEN^T00030CLINNAME^T00030DATE_OF_REQUEST^T00030PRIO"
; 9 10 11
S SDTMP=SDTMP_"^T00030PROVIEN^T00030PROVNAME^T00030SERVICE_RENDERED_AS"
; 12 13 14 15 16 17
S SDTMP=SDTMP_"^T00100STOP^T00030PRHBLOC^T00030EARLIEST^T00030CPHONE^T00030CLET^T00030COVID_PRIORITY"
S @SDECY@(SDECI)=SDTMP_$C(30)
Q
SELCONS ;selection all open consults - those consults in PENDING and ACTIVE status
N SDCONSID,CPRSSTAT,SDURGEN,SDREQTYPE,STOP,SIEN,SDTOSVC,PRHBLOC,COVPRIORITY,IFCSTAT
N SDORIGDT,SDTOSVC,SDTOSVCI,SDCLIEN,SDCLNAME,SDDOREQ,SDPRIO,SDPRIEN,SDPRNAME,SDSRA,SDCOMM,SDSTOP
N SDCONLET,SDCONTACT,SDEARLI,SDLET
S SDCONSID=""
F S SDCONSID=$O(^GMR(123,"F",DFN,SDCONSID)) Q:SDCONSID="" D
.S CPRSSTAT=$$GET1^DIQ(123,SDCONSID,8,"I")
.S IFCSTAT=$$GET1^DIQ(123,SDCONSID,.125,"I")
.I (IFCSTAT'="P")&((CPRSSTAT=ACTIVE)!(CPRSSTAT=PENDING)) D
..D ASSIGNINFO
..D BLDREC
;
Q
;
ASSIGNINFO ;
N SDCONSARR,SDARRERR,SDECALL,SDECLET
D GETS^DIQ(123,SDCONSID,".01;.05;1;2;3;5;10;13;14;17","IE","SDCONSARR","SDARRERR")
S SDORIGDT=$G(SDCONSARR(123,SDCONSID_",",.01,"I"))
S SDTOSVC=$G(SDCONSARR(123,SDCONSID_",",1,"E"))
S SDTOSVCI=$G(SDCONSARR(123,SDCONSID_",",1,"I"))
S SDCLIEN=$G(SDCONSARR(123,SDCONSID_",",2,"I")) S:SDCLIEN="" SDCLIEN=$G(SDCONSARR(123,SDCONSID_",",.05,"I"))
S SDCLNAME=$G(SDCONSARR(123,SDCONSID_",",2,"E")) S:SDCLNAME="" SDCLNAME=$G(SDCONSARR(123,SDCONSID_",",.05))
S SDDOREQ=$G(SDCONSARR(123,SDCONSID_",",3,"I"))
S SDREQTYPE=$G(SDCONSARR(123,SDCONSID_",",13,"E"))
S SDPRIO=$$PRIO^SDEC51A(SDCONSID)
S SDPRIEN=$G(SDCONSARR(123,SDCONSID_",",10,"I"))
S SDPRNAME=$G(SDCONSARR(123,SDCONSID_",",10,"E"))
S SDSRA=$G(SDCONSARR(123,SDCONSID_",",14,"E"))
S SDEARLI=$G(SDCONSARR(123,SDCONSID_",",17,"I"))
S SDSTOP="",STOP=""
I +SDTOSVCI D
.S SIEN=0 F S SIEN=$O(^GMR(123.5,SDTOSVCI,688,SIEN)) Q:'+SIEN D
..S STOP=$$GET1^DIQ(123.5688,SIEN_","_SDTOSVCI_",",.01,"I") ;ICR 4557
..I SDSTOP="" S SDSTOP=STOP
..E S SDSTOP=SDSTOP_"|"_STOP
S PRHBLOC=$S($$GET1^DIQ(44,+SDCLIEN_",",2500,"I")="Y":1,1:0)
S SDCONLET=$$CALLCON^SDECAR1A(DFN,SDCONSID) ; SDECALL_U_SDECLET # OF CALLS MADE^DATE LAST LETTER SENT
S SDCONTACT=$P(SDCONLET,U,1)
S SDLET=$P(SDCONLET,U,2)
S COVPRIORITY=$$PRIORITY^SDEC51(SDCONSID) ; Get covid priority
Q
;
BLDREC ;build consult record
;
; Consult IEN^Request Type^ORIGDT^TO Service^CLINIEN^CLINNAME^Date of Request
S SDTMP=SDCONSID_U_SDREQTYPE_U_SDORIGDT_U_SDTOSVC_U_SDCLIEN_U_SDCLNAME_U_SDDOREQ
; Prio^Provider IEN^Provider Name^Service Rendered As
S SDTMP=SDTMP_U_SDPRIO_U_SDPRIEN_U_SDPRNAME_U_SDSRA
; Req_Proc_Act^Stop^PRHBLOC^Earliest
S SDTMP=SDTMP_U_SDSTOP_U_PRHBLOC_U_SDEARLI
; CPHONE^CLET^Covid_Priority
S SDTMP=SDTMP_U_SDCONTACT_U_SDLET_U_COVPRIORITY
S SDECI=SDECI+1 S ^TMP("SDEC51B",$J,SDECI)=SDTMP_$C(30)
Q
;
EXIT ;
I SDECI=0 D
. S SDECI=SDECI+1
. S ^TMP("SDEC51B",$J,SDECI)=0_$C(30)
S ^TMP("SDEC51B",$J,SDECI)=^TMP("SDEC51B",$J,SDECI)_$C(31)
Q
;
CONSULT1(SDECY,SDCONSID) ; RPC: SDEC GET PAT CONSULT BY IEN - Return a CONSULT
;INPUT - SDCONSID (Consult ID) IEN to REQUEST/CONSULTATION (#123) File.
;RETURN PARAMETER:
; Consults in ACTIVE or PENDING CPRS STATUS. Data is delimited by carat (^).
; Field List:
; (1) Internal IEN
; (2) Request Type
; (3) File Entry Date
; (4) To Service/Specialty
; (5) Clinic IEN
; (6) Clinic Name
; (7) Date of Request
; (8) URGENCY name or Earliest date
; (9) Provider IEN
; (10) Provider Name
; (11) Service Rendered as in or outpatient
; (12) Associated Stop Code
; (13) Prohibited Clinic Flag
; (14) Clinic indicated Date
; (15) # of Phone contacts
; (16) Date of Last Letter
; (17) Covid Priority
;
N DFN,ACTIVE,PENDING,ERRPOP,ERRMSG,SDECI,SDTMP,COVPRIORITY,PRHBLOC,SDCLIEN
N SDCLNAME,SDCONLET,SDCONSARR,SDCONTACT,SDDOREQ,SDEARLI,SDECALL,SDECI
N SDECLET,SDLET,SDORIGDT,SDPRIEN,SDPRIO,SDPRNAME,SDREQTYPE,SDSRA,SDSTOP,SDTMP
N SDTOSVCI,SIEN,STOP,SDTOSVC
D INIT
D VALIDATE1
I ERRPOP D ERR1^SDECERR(-1,ERRMSG,.SDECI,SDECY) Q
S DFN=$$GET1^DIQ(123,SDCONSID,.02,"I")
D ASSIGNINFO
D BLDREC
D EXIT
Q
;
VALIDATE1 ;
;*Add validation of DFN
I '(+SDCONSID) D Q
.;create error message - Consultation ID is required
.S ERRMSG="Consultation ID is required."
.S ERRPOP=1
I '$D(^GMR(123,SDCONSID,0)) D
.;create error - Invalid Consult ID
.S ERRMSG="Invalid Consult ID."
.S ERRPOP=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC51B 7027 printed Oct 16, 2024@18:51:18 Page 2
SDEC51B ;ALB/LAB,ANU - VISTA SCHEDULING RPCS ;APR 12, 2021@14:39
+1 ;;5.3;Scheduling;**784,785**;Aug 13, 1993;Build 14
+2 ;
+3 ; Documented API's and Integration Agreements
+4 ; -------------------------------------------
+5 ; Reference to ^GMR(123 In ICR #4837
+6 ; Reference to ^GMR(123.5 In ICR #4557
+7 ; Reference to ^GMR(123 In ICR #6185
+8 ; Reference to ^ORD(100.01 In ICR #2638
+9 ; Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056
+10 QUIT
+11 ;
CONSLIST(SDECY,DFN) ;Return a list of ACTIVE or PENDING CONSULTS for patient
+1 ;INPUT - DFN (Date File Number) Pointer to PATIENT (#2) File.
+2 ;RETURN PARMETER:
+3 ; List of consults in ACTIVE or PENDING CPRS STATUS. Data is delimited by
+4 ; carat (^).
+5 ; Field List:
+6 ; (1) Internal IEN
+7 ; (2) Request Type
+8 ; (3) File Entry Date
+9 ; (4) To Service/Specialty
+10 ; (5) Clinic IEN
+11 ; (6) Clinic Name
+12 ; (7) Date of Request
+13 ; (8) URGENCY name or Earliest date
+14 ; (9) Provider IEN
+15 ; (10) Provider Name
+16 ; (11) Service Rendered as in or outpatient
+17 ; (12) Associated Stop Code
+18 ; (13) Prohibited Clinic Flag
+19 ; (14) Clinic indicated Date
+20 ; (15) # of Phone contacts
+21 ; (16) Date of Last Letter
+22 ; (17) Covid Priority
+23 ;
+24 NEW ACTIVE,PENDING,ERRPOP,ERRMSG,SDECI,SDTMP
+25 SET SDECI=$GET(SDECI,0)
+26 DO INIT
+27 DO VALIDATE
+28 IF ERRPOP
DO ERR1^SDECERR(-1,ERRMSG,.SDECI,SDECY)
QUIT
+29 ;select "open" consults
DO SELCONS
+30 DO EXIT
+31 QUIT
+32 ;
INIT ;
+1 KILL ^TMP("SDEC51B",$JOB)
+2 SET SDECY="^TMP(""SDEC51B"","_$JOB_")"
+3 SET ACTIVE=$ORDER(^ORD(100.01,"B","ACTIVE",0))
+4 SET PENDING=$ORDER(^ORD(100.01,"B","PENDING",0))
+5 SET ERRPOP=0
SET SDECI=0
SET ERRMSG=""
+6 ; data header
+7 DO HDR
+8 QUIT
+9 ;
VALIDATE ;
+1 ;*Add validation of DFN
+2 IF '(+DFN)
Begin DoDot:1
+3 ;create error message - DFN required
+4 SET ERRMSG="DFN required. "
+5 SET ERRPOP=1
End DoDot:1
QUIT
+6 IF '$DATA(^DPT(DFN,0))
Begin DoDot:1
+7 ;create error - Invalid DFN
+8 SET ERRMSG="Invalid DFN"
+9 SET ERRPOP=1
End DoDot:1
+10 QUIT
+11 ;
HDR ;Get the header information
+1 ;
+2 ; Consult IEN^Request Type^ORIGDT^TO Service^CLINIEN^CLINNAME^Date of Request
+3 ; Prio^Provider IEN^Provider Name^Service Rendered As
+4 ; Req_Proc_Act^Stop^PRHBLOC^Earliest
+5 ; CPHONE^CLET^Covid_Priority
+6 ; 1 2 3 4
+7 SET SDTMP="T00020CONSULTIEN^T00020REQTYPE^T00020ORIGDT^T00030TO_SERVICE"
+8 ; 5 6 7 8
+9 SET SDTMP=SDTMP_"^T00010CLINIEN^T00030CLINNAME^T00030DATE_OF_REQUEST^T00030PRIO"
+10 ; 9 10 11
+11 SET SDTMP=SDTMP_"^T00030PROVIEN^T00030PROVNAME^T00030SERVICE_RENDERED_AS"
+12 ; 12 13 14 15 16 17
+13 SET SDTMP=SDTMP_"^T00100STOP^T00030PRHBLOC^T00030EARLIEST^T00030CPHONE^T00030CLET^T00030COVID_PRIORITY"
+14 SET @SDECY@(SDECI)=SDTMP_$CHAR(30)
+15 QUIT
SELCONS ;selection all open consults - those consults in PENDING and ACTIVE status
+1 NEW SDCONSID,CPRSSTAT,SDURGEN,SDREQTYPE,STOP,SIEN,SDTOSVC,PRHBLOC,COVPRIORITY,IFCSTAT
+2 NEW SDORIGDT,SDTOSVC,SDTOSVCI,SDCLIEN,SDCLNAME,SDDOREQ,SDPRIO,SDPRIEN,SDPRNAME,SDSRA,SDCOMM,SDSTOP
+3 NEW SDCONLET,SDCONTACT,SDEARLI,SDLET
+4 SET SDCONSID=""
+5 FOR
SET SDCONSID=$ORDER(^GMR(123,"F",DFN,SDCONSID))
if SDCONSID=""
QUIT
Begin DoDot:1
+6 SET CPRSSTAT=$$GET1^DIQ(123,SDCONSID,8,"I")
+7 SET IFCSTAT=$$GET1^DIQ(123,SDCONSID,.125,"I")
+8 IF (IFCSTAT'="P")&((CPRSSTAT=ACTIVE)!(CPRSSTAT=PENDING))
Begin DoDot:2
+9 DO ASSIGNINFO
+10 DO BLDREC
End DoDot:2
End DoDot:1
+11 ;
+12 QUIT
+13 ;
ASSIGNINFO ;
+1 NEW SDCONSARR,SDARRERR,SDECALL,SDECLET
+2 DO GETS^DIQ(123,SDCONSID,".01;.05;1;2;3;5;10;13;14;17","IE","SDCONSARR","SDARRERR")
+3 SET SDORIGDT=$GET(SDCONSARR(123,SDCONSID_",",.01,"I"))
+4 SET SDTOSVC=$GET(SDCONSARR(123,SDCONSID_",",1,"E"))
+5 SET SDTOSVCI=$GET(SDCONSARR(123,SDCONSID_",",1,"I"))
+6 SET SDCLIEN=$GET(SDCONSARR(123,SDCONSID_",",2,"I"))
if SDCLIEN=""
SET SDCLIEN=$GET(SDCONSARR(123,SDCONSID_",",.05,"I"))
+7 SET SDCLNAME=$GET(SDCONSARR(123,SDCONSID_",",2,"E"))
if SDCLNAME=""
SET SDCLNAME=$GET(SDCONSARR(123,SDCONSID_",",.05))
+8 SET SDDOREQ=$GET(SDCONSARR(123,SDCONSID_",",3,"I"))
+9 SET SDREQTYPE=$GET(SDCONSARR(123,SDCONSID_",",13,"E"))
+10 SET SDPRIO=$$PRIO^SDEC51A(SDCONSID)
+11 SET SDPRIEN=$GET(SDCONSARR(123,SDCONSID_",",10,"I"))
+12 SET SDPRNAME=$GET(SDCONSARR(123,SDCONSID_",",10,"E"))
+13 SET SDSRA=$GET(SDCONSARR(123,SDCONSID_",",14,"E"))
+14 SET SDEARLI=$GET(SDCONSARR(123,SDCONSID_",",17,"I"))
+15 SET SDSTOP=""
SET STOP=""
+16 IF +SDTOSVCI
Begin DoDot:1
+17 SET SIEN=0
FOR
SET SIEN=$ORDER(^GMR(123.5,SDTOSVCI,688,SIEN))
if '+SIEN
QUIT
Begin DoDot:2
+18 ;ICR 4557
SET STOP=$$GET1^DIQ(123.5688,SIEN_","_SDTOSVCI_",",.01,"I")
+19 IF SDSTOP=""
SET SDSTOP=STOP
+20 IF '$TEST
SET SDSTOP=SDSTOP_"|"_STOP
End DoDot:2
End DoDot:1
+21 SET PRHBLOC=$SELECT($$GET1^DIQ(44,+SDCLIEN_",",2500,"I")="Y":1,1:0)
+22 ; SDECALL_U_SDECLET # OF CALLS MADE^DATE LAST LETTER SENT
SET SDCONLET=$$CALLCON^SDECAR1A(DFN,SDCONSID)
+23 SET SDCONTACT=$PIECE(SDCONLET,U,1)
+24 SET SDLET=$PIECE(SDCONLET,U,2)
+25 ; Get covid priority
SET COVPRIORITY=$$PRIORITY^SDEC51(SDCONSID)
+26 QUIT
+27 ;
BLDREC ;build consult record
+1 ;
+2 ; Consult IEN^Request Type^ORIGDT^TO Service^CLINIEN^CLINNAME^Date of Request
+3 SET SDTMP=SDCONSID_U_SDREQTYPE_U_SDORIGDT_U_SDTOSVC_U_SDCLIEN_U_SDCLNAME_U_SDDOREQ
+4 ; Prio^Provider IEN^Provider Name^Service Rendered As
+5 SET SDTMP=SDTMP_U_SDPRIO_U_SDPRIEN_U_SDPRNAME_U_SDSRA
+6 ; Req_Proc_Act^Stop^PRHBLOC^Earliest
+7 SET SDTMP=SDTMP_U_SDSTOP_U_PRHBLOC_U_SDEARLI
+8 ; CPHONE^CLET^Covid_Priority
+9 SET SDTMP=SDTMP_U_SDCONTACT_U_SDLET_U_COVPRIORITY
+10 SET SDECI=SDECI+1
SET ^TMP("SDEC51B",$JOB,SDECI)=SDTMP_$CHAR(30)
+11 QUIT
+12 ;
EXIT ;
+1 IF SDECI=0
Begin DoDot:1
+2 SET SDECI=SDECI+1
+3 SET ^TMP("SDEC51B",$JOB,SDECI)=0_$CHAR(30)
End DoDot:1
+4 SET ^TMP("SDEC51B",$JOB,SDECI)=^TMP("SDEC51B",$JOB,SDECI)_$CHAR(31)
+5 QUIT
+6 ;
CONSULT1(SDECY,SDCONSID) ; RPC: SDEC GET PAT CONSULT BY IEN - Return a CONSULT
+1 ;INPUT - SDCONSID (Consult ID) IEN to REQUEST/CONSULTATION (#123) File.
+2 ;RETURN PARAMETER:
+3 ; Consults in ACTIVE or PENDING CPRS STATUS. Data is delimited by carat (^).
+4 ; Field List:
+5 ; (1) Internal IEN
+6 ; (2) Request Type
+7 ; (3) File Entry Date
+8 ; (4) To Service/Specialty
+9 ; (5) Clinic IEN
+10 ; (6) Clinic Name
+11 ; (7) Date of Request
+12 ; (8) URGENCY name or Earliest date
+13 ; (9) Provider IEN
+14 ; (10) Provider Name
+15 ; (11) Service Rendered as in or outpatient
+16 ; (12) Associated Stop Code
+17 ; (13) Prohibited Clinic Flag
+18 ; (14) Clinic indicated Date
+19 ; (15) # of Phone contacts
+20 ; (16) Date of Last Letter
+21 ; (17) Covid Priority
+22 ;
+23 NEW DFN,ACTIVE,PENDING,ERRPOP,ERRMSG,SDECI,SDTMP,COVPRIORITY,PRHBLOC,SDCLIEN
+24 NEW SDCLNAME,SDCONLET,SDCONSARR,SDCONTACT,SDDOREQ,SDEARLI,SDECALL,SDECI
+25 NEW SDECLET,SDLET,SDORIGDT,SDPRIEN,SDPRIO,SDPRNAME,SDREQTYPE,SDSRA,SDSTOP,SDTMP
+26 NEW SDTOSVCI,SIEN,STOP,SDTOSVC
+27 DO INIT
+28 DO VALIDATE1
+29 IF ERRPOP
DO ERR1^SDECERR(-1,ERRMSG,.SDECI,SDECY)
QUIT
+30 SET DFN=$$GET1^DIQ(123,SDCONSID,.02,"I")
+31 DO ASSIGNINFO
+32 DO BLDREC
+33 DO EXIT
+34 QUIT
+35 ;
VALIDATE1 ;
+1 ;*Add validation of DFN
+2 IF '(+SDCONSID)
Begin DoDot:1
+3 ;create error message - Consultation ID is required
+4 SET ERRMSG="Consultation ID is required."
+5 SET ERRPOP=1
End DoDot:1
QUIT
+6 IF '$DATA(^GMR(123,SDCONSID,0))
Begin DoDot:1
+7 ;create error - Invalid Consult ID
+8 SET ERRMSG="Invalid Consult ID."
+9 SET ERRPOP=1
End DoDot:1
+10 QUIT
