SDECCONSJSON ;ALB/ANU,MGD,LAB/BLB - VISTA SCHEDULING RPCS ;MAR 31, 2022@14:39
;;5.3;Scheduling;**784,785,788,805,807,813,877,886**;Aug 13, 1993;Build 13
;
; 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
;
JSONCONSLIST(SDCONJSON,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
; Number of Email Contacts
; Number of Text Contacts
; Number of Secure messages contact
;
N ACTIVE,PENDING,ERRPOP,ERRMSG,SDECI,SDTMP,SDCONSREC,ERR
S SDECI=$G(SDECI,0),ERR=""
D INIT
D VALIDATE
I ERRPOP D BLDJSON Q
D JSONSELCONS ;select "open" consults
Q
;
INIT ; initialize values needed
S ACTIVE=$O(^ORD(100.01,"B","ACTIVE",0))
S PENDING=$O(^ORD(100.01,"B","PENDING",0))
S ERRPOP=0,SDECI=0,ERRMSG=""
Q
;
VALIDATE ; validate incoming parameters
;*Add validation of DFN
I '(+DFN) D
. ;create error message - DFN required
. D ERRLOG^SDESJSON(.SDCONSREC,1)
. S ERRPOP=1
I $G(DFN)>0,'$D(^DPT(DFN,0)) D
. ;create error - Invalid DFN
. D ERRLOG^SDESJSON(.SDCONSREC,2)
. S ERRPOP=1
Q
;
JSONSELCONS ;selection all open consults - those consults in PENDING and ACTIVE status
N SDCONSID,CPRSSTAT,IFCSTAT,CPRSSTAT
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 BLDCONSULTREC
I '$D(SDCONSREC("Consult")) S SDCONSREC("Consult")=""
D BLDJSON
K SDCONSARR
Q
;
BLDCONSULTREC ;Build a consult record for every consult
N SDCLIEN,SDCLNAME,SDCONLET,SDSTOP,STOP,SIEN,SDTOSVCI,SDCONSARR,SDARRERR,CANCHANGEPID,PID
D GETS^DIQ(123,SDCONSID,".01;.05;1;2;3;5;10;13;14;17","IE","SDCONSARR","SDARRERR")
S SDECI=SDECI+1
S SDCONSREC("Consult",SDECI,"ConsultIEN")=SDCONSID
S SDCONSREC("Consult",SDECI,"RequestType")=$G(SDCONSARR(123,SDCONSID_",",13,"E"))
S SDCONSREC("Consult",SDECI,"FileEntryDate")=$G(SDCONSARR(123,SDCONSID_",",.01,"I"))
S SDCONSREC("Consult",SDECI,"ToService")=$G(SDCONSARR(123,SDCONSID_",",1,"E"))
;Need explanation of why for clinic ien and name
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 SDCONSREC("Consult",SDECI,"ClinicIEN")=SDCLIEN
S SDCONSREC("Consult",SDECI,"ClinicName")=SDCLNAME
S SDCONSREC("Consult",SDECI,"DateOfRequest")=$G(SDCONSARR(123,SDCONSID_",",3,"I"))
S SDCONSREC("Consult",SDECI,"UrgencyOrEarliestDate")=$$PRIO^SDEC51A(SDCONSID)
S SDCONSREC("Consult",SDECI,"ProviderIEN")=$G(SDCONSARR(123,SDCONSID_",",10,"I"))
S SDCONSREC("Consult",SDECI,"ProviderName")=$G(SDCONSARR(123,SDCONSID_",",10,"E"))
S SDCONSREC("Consult",SDECI,"ServiceRenderedAs")=$G(SDCONSARR(123,SDCONSID_",",14,"E"))
S SDCONSREC("Consult",SDECI,"ProhibitedClinicFlag")=$S($$GET1^DIQ(44,+SDCLIEN_",",2500,"I")="Y":1,1:0)
I $D(^SDEC(409.87,"B",SDCONSID)) D
.S PID=$$GETPID(SDCONSID)
.S SDCONSREC("Consult",SDECI,"ClinicIndicatedDate")=PID
I '$D(^SDEC(409.87,"B",SDCONSID)) D
.S SDCONSREC("Consult",SDECI,"ClinicIndicatedDate")=$G(SDCONSARR(123,SDCONSID_",",17,"I"))
S SDCONLET=$$CALLCON^SDECAR1A(DFN,SDCONSID) ; # OF CALLS MADE^DATE LAST LETTER SENT
K SDECALL,SDECLET ; Returned from call to $$CALLCON^SDECAR1A
S SDCONSREC("Consult",SDECI,"NumberOfPhoneContact")=$P(SDCONLET,U,1)
S SDCONSREC("Consult",SDECI,"DateOfLastLetter")=$P(SDCONLET,U,2)
S SDCONSREC("Consult",SDECI,"NumberOfEmailContact")=$P(SDCONLET,U,3) ;813
S SDCONSREC("Consult",SDECI,"NumberOfTextContact")=$P(SDCONLET,U,4) ;813
S SDCONSREC("Consult",SDECI,"NumberOfSecureMessage")=$P(SDCONLET,U,5) ;813
S SDCONSREC("Consult",SDECI,"CovidPriority")=$$PRIORITY^SDEC51(SDCONSID) ; Get Covid priority
S SDCONSREC("Consult",SDECI,"CanEditPid")=$$CONSCANCELCHECK^SDES2GETCONSULTS(SDCONSID,$$GET1^DIQ(123,SDCONSID,.02,"I"))
;build stop code list
S SDSTOP="",STOP=""
S SDTOSVCI=$G(SDCONSARR(123,SDCONSID_",",1,"I"))
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 SDCONSREC("Consult",SDECI,"AssociateStopCode")=SDSTOP
Q
;
GETPID(SDCONSID) ;
N CHIEN,CHSIEN,OLDESTPID
S CHIEN=$O(^SDEC(409.87,"B",SDCONSID,0))
S CHSIEN=$O(^SDEC(409.87,CHIEN,1,9999999),-1)
S OLDESTPID=$$GET1^DIQ(409.871,CHSIEN_","_CHIEN_",",1,"I")
Q OLDESTPID
;
BLDJSON ;
D ENCODE^SDESJSON(.SDCONSREC,.SDCONJSON,.ERR)
K SDCONSREC
Q
;
JSONCONSLIST1(SDCONJSON,SDCONSID) ;Return a single ACTIVE or PENDING CONSULT for a patient
;INPUT - SDCONSID (Consult ID) IEN to REQUEST/CONSULTATION (#123) 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
; Number of Email Contacts
; Number of Text Contacts
; Number of Secure messages contact
;
N ACTIVE,PENDING,ERRPOP,ERRMSG,SDECI,SDTMP,SDCONSREC,DFN,ERR
S SDECI=$G(SDECI,0),ERR=""
D INIT
D VALIDATE1
I ERRPOP D BLDJSON Q
S DFN=$$GET1^DIQ(123,SDCONSID,.02,"I")
D BLDCONSULTREC
D BLDJSON
K SDCONSARR
Q
;
VALIDATE1 ;
; *Add validation of IEN
I '(+SDCONSID) D
. ; create error message - Consultation ID is required
. D ERRLOG^SDESJSON(.SDCONSREC,5)
. S ERRPOP=1
I $G(SDCONSID)>0,'$D(^GMR(123,SDCONSID,0)) D
. ; create error - Invalid Consult ID
. D ERRLOG^SDESJSON(.SDCONSREC,6)
. S ERRPOP=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECCONSJSON 7063 printed Sep 23, 2025@20:28:17 Page 2
SDECCONSJSON ;ALB/ANU,MGD,LAB/BLB - VISTA SCHEDULING RPCS ;MAR 31, 2022@14:39
+1 ;;5.3;Scheduling;**784,785,788,805,807,813,877,886**;Aug 13, 1993;Build 13
+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 ;
JSONCONSLIST(SDCONJSON,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 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 ; Number of Email Contacts
+23 ; Number of Text Contacts
+24 ; Number of Secure messages contact
+25 ;
+26 NEW ACTIVE,PENDING,ERRPOP,ERRMSG,SDECI,SDTMP,SDCONSREC,ERR
+27 SET SDECI=$GET(SDECI,0)
SET ERR=""
+28 DO INIT
+29 DO VALIDATE
+30 IF ERRPOP
DO BLDJSON
QUIT
+31 ;select "open" consults
DO JSONSELCONS
+32 QUIT
+33 ;
INIT ; initialize values needed
+1 SET ACTIVE=$ORDER(^ORD(100.01,"B","ACTIVE",0))
+2 SET PENDING=$ORDER(^ORD(100.01,"B","PENDING",0))
+3 SET ERRPOP=0
SET SDECI=0
SET ERRMSG=""
+4 QUIT
+5 ;
VALIDATE ; validate incoming parameters
+1 ;*Add validation of DFN
+2 IF '(+DFN)
Begin DoDot:1
+3 ;create error message - DFN required
+4 DO ERRLOG^SDESJSON(.SDCONSREC,1)
+5 SET ERRPOP=1
End DoDot:1
+6 IF $GET(DFN)>0
IF '$DATA(^DPT(DFN,0))
Begin DoDot:1
+7 ;create error - Invalid DFN
+8 DO ERRLOG^SDESJSON(.SDCONSREC,2)
+9 SET ERRPOP=1
End DoDot:1
+10 QUIT
+11 ;
JSONSELCONS ;selection all open consults - those consults in PENDING and ACTIVE status
+1 NEW SDCONSID,CPRSSTAT,IFCSTAT,CPRSSTAT
+2 SET SDCONSID=""
+3 FOR
SET SDCONSID=$ORDER(^GMR(123,"F",DFN,SDCONSID))
if SDCONSID=""
QUIT
Begin DoDot:1
+4 SET CPRSSTAT=$$GET1^DIQ(123,SDCONSID,8,"I")
+5 SET IFCSTAT=$$GET1^DIQ(123,SDCONSID,.125,"I")
+6 IF (IFCSTAT'="P")&((CPRSSTAT=ACTIVE)!(CPRSSTAT=PENDING))
Begin DoDot:2
+7 DO BLDCONSULTREC
End DoDot:2
End DoDot:1
+8 IF '$DATA(SDCONSREC("Consult"))
SET SDCONSREC("Consult")=""
+9 DO BLDJSON
+10 KILL SDCONSARR
+11 QUIT
+12 ;
BLDCONSULTREC ;Build a consult record for every consult
+1 NEW SDCLIEN,SDCLNAME,SDCONLET,SDSTOP,STOP,SIEN,SDTOSVCI,SDCONSARR,SDARRERR,CANCHANGEPID,PID
+2 DO GETS^DIQ(123,SDCONSID,".01;.05;1;2;3;5;10;13;14;17","IE","SDCONSARR","SDARRERR")
+3 SET SDECI=SDECI+1
+4 SET SDCONSREC("Consult",SDECI,"ConsultIEN")=SDCONSID
+5 SET SDCONSREC("Consult",SDECI,"RequestType")=$GET(SDCONSARR(123,SDCONSID_",",13,"E"))
+6 SET SDCONSREC("Consult",SDECI,"FileEntryDate")=$GET(SDCONSARR(123,SDCONSID_",",.01,"I"))
+7 SET SDCONSREC("Consult",SDECI,"ToService")=$GET(SDCONSARR(123,SDCONSID_",",1,"E"))
+8 ;Need explanation of why for clinic ien and name
+9 SET SDCLIEN=$GET(SDCONSARR(123,SDCONSID_",",2,"I"))
if SDCLIEN=""
SET SDCLIEN=$GET(SDCONSARR(123,SDCONSID_",",.05,"I"))
+10 SET SDCLNAME=$GET(SDCONSARR(123,SDCONSID_",",2,"E"))
if SDCLNAME=""
SET SDCLNAME=$GET(SDCONSARR(123,SDCONSID_",",.05))
+11 SET SDCONSREC("Consult",SDECI,"ClinicIEN")=SDCLIEN
+12 SET SDCONSREC("Consult",SDECI,"ClinicName")=SDCLNAME
+13 SET SDCONSREC("Consult",SDECI,"DateOfRequest")=$GET(SDCONSARR(123,SDCONSID_",",3,"I"))
+14 SET SDCONSREC("Consult",SDECI,"UrgencyOrEarliestDate")=$$PRIO^SDEC51A(SDCONSID)
+15 SET SDCONSREC("Consult",SDECI,"ProviderIEN")=$GET(SDCONSARR(123,SDCONSID_",",10,"I"))
+16 SET SDCONSREC("Consult",SDECI,"ProviderName")=$GET(SDCONSARR(123,SDCONSID_",",10,"E"))
+17 SET SDCONSREC("Consult",SDECI,"ServiceRenderedAs")=$GET(SDCONSARR(123,SDCONSID_",",14,"E"))
+18 SET SDCONSREC("Consult",SDECI,"ProhibitedClinicFlag")=$SELECT($$GET1^DIQ(44,+SDCLIEN_",",2500,"I")="Y":1,1:0)
+19 IF $DATA(^SDEC(409.87,"B",SDCONSID))
Begin DoDot:1
+20 SET PID=$$GETPID(SDCONSID)
+21 SET SDCONSREC("Consult",SDECI,"ClinicIndicatedDate")=PID
End DoDot:1
+22 IF '$DATA(^SDEC(409.87,"B",SDCONSID))
Begin DoDot:1
+23 SET SDCONSREC("Consult",SDECI,"ClinicIndicatedDate")=$GET(SDCONSARR(123,SDCONSID_",",17,"I"))
End DoDot:1
+24 ; # OF CALLS MADE^DATE LAST LETTER SENT
SET SDCONLET=$$CALLCON^SDECAR1A(DFN,SDCONSID)
+25 ; Returned from call to $$CALLCON^SDECAR1A
KILL SDECALL,SDECLET
+26 SET SDCONSREC("Consult",SDECI,"NumberOfPhoneContact")=$PIECE(SDCONLET,U,1)
+27 SET SDCONSREC("Consult",SDECI,"DateOfLastLetter")=$PIECE(SDCONLET,U,2)
+28 ;813
SET SDCONSREC("Consult",SDECI,"NumberOfEmailContact")=$PIECE(SDCONLET,U,3)
+29 ;813
SET SDCONSREC("Consult",SDECI,"NumberOfTextContact")=$PIECE(SDCONLET,U,4)
+30 ;813
SET SDCONSREC("Consult",SDECI,"NumberOfSecureMessage")=$PIECE(SDCONLET,U,5)
+31 ; Get Covid priority
SET SDCONSREC("Consult",SDECI,"CovidPriority")=$$PRIORITY^SDEC51(SDCONSID)
+32 SET SDCONSREC("Consult",SDECI,"CanEditPid")=$$CONSCANCELCHECK^SDES2GETCONSULTS(SDCONSID,$$GET1^DIQ(123,SDCONSID,.02,"I"))
+33 ;build stop code list
+34 SET SDSTOP=""
SET STOP=""
+35 SET SDTOSVCI=$GET(SDCONSARR(123,SDCONSID_",",1,"I"))
+36 IF +SDTOSVCI
Begin DoDot:1
+37 SET SIEN=0
FOR
SET SIEN=$ORDER(^GMR(123.5,SDTOSVCI,688,SIEN))
if '+SIEN
QUIT
Begin DoDot:2
+38 ;ICR 4557
SET STOP=$$GET1^DIQ(123.5688,SIEN_","_SDTOSVCI_",",.01,"I")
+39 IF SDSTOP=""
SET SDSTOP=STOP
+40 IF '$TEST
SET SDSTOP=SDSTOP_"|"_STOP
End DoDot:2
End DoDot:1
+41 SET SDCONSREC("Consult",SDECI,"AssociateStopCode")=SDSTOP
+42 QUIT
+43 ;
GETPID(SDCONSID) ;
+1 NEW CHIEN,CHSIEN,OLDESTPID
+2 SET CHIEN=$ORDER(^SDEC(409.87,"B",SDCONSID,0))
+3 SET CHSIEN=$ORDER(^SDEC(409.87,CHIEN,1,9999999),-1)
+4 SET OLDESTPID=$$GET1^DIQ(409.871,CHSIEN_","_CHIEN_",",1,"I")
+5 QUIT OLDESTPID
+6 ;
BLDJSON ;
+1 DO ENCODE^SDESJSON(.SDCONSREC,.SDCONJSON,.ERR)
+2 KILL SDCONSREC
+3 QUIT
+4 ;
JSONCONSLIST1(SDCONJSON,SDCONSID) ;Return a single ACTIVE or PENDING CONSULT for a patient
+1 ;INPUT - SDCONSID (Consult ID) IEN to REQUEST/CONSULTATION (#123) File.
+2 ;RETURN PARMETER:
+3 ; List of 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 ; Number of Email Contacts
+23 ; Number of Text Contacts
+24 ; Number of Secure messages contact
+25 ;
+26 NEW ACTIVE,PENDING,ERRPOP,ERRMSG,SDECI,SDTMP,SDCONSREC,DFN,ERR
+27 SET SDECI=$GET(SDECI,0)
SET ERR=""
+28 DO INIT
+29 DO VALIDATE1
+30 IF ERRPOP
DO BLDJSON
QUIT
+31 SET DFN=$$GET1^DIQ(123,SDCONSID,.02,"I")
+32 DO BLDCONSULTREC
+33 DO BLDJSON
+34 KILL SDCONSARR
+35 QUIT
+36 ;
VALIDATE1 ;
+1 ; *Add validation of IEN
+2 IF '(+SDCONSID)
Begin DoDot:1
+3 ; create error message - Consultation ID is required
+4 DO ERRLOG^SDESJSON(.SDCONSREC,5)
+5 SET ERRPOP=1
End DoDot:1
+6 IF $GET(SDCONSID)>0
IF '$DATA(^GMR(123,SDCONSID,0))
Begin DoDot:1
+7 ; create error - Invalid Consult ID
+8 DO ERRLOG^SDESJSON(.SDCONSREC,6)
+9 SET ERRPOP=1
End DoDot:1
+10 QUIT
