SDECCON ;SPFO/DMR,MGD,RRM,TAW - SCHEDULING ENHANCEMENTS VSE CONTACT API ;OCT 16, 2025
;;5.3;Scheduling;**669,686,781,785,827,922**;Aug 13 1993;Build 7
;
;This API provides SDEC CONTACT(#409.86)file information to the VSE VS GUI.
; 3/6/18 - wtc/zeb Added new cross-reference for audit statistics compiler. Patch 686
;
Q
DISPLAY(RTU,DFN,CLN,PDT,REQT,SER) ;
; RPC: SDEC CONTACT DISPLAY
Q:'$G(DFN)
Q:'$G(PDT)
Q:'$D(REQT)
S (CC,CC1,CC2,REC)=""
;
S PDT=$$NETTOFM^SDECDATE(PDT,"N","N") ;CONVERT TO FILEMAN DATE
;
S CC="" F S CC=$O(^SDEC(409.86,"B",DFN,CC)) Q:CC="" D
.S REC="" S REC=^SDEC(409.86,CC,0)
.Q:PDT'=$P($G(REC),"^",3)
.I $G(CLN)'="" Q:$G(CLN)'=$P($G(REC),"^",2)
.I $G(SER)'="" Q:$G(SER)'=$P($G(REC),"^",6)
.Q:REQT'=$P($G(REC),"^",4)
.S RTU=CC_"^"_REC
.Q
D EXIT
Q
;
DISPLAY1(RTU,REQT,RIEN) ;
; RPC: SDEC CONTACT DISPLAY SINGLE
; INPUT: REQT = Request Type: SDEC CONTACT, REQUEST/CONSULTATION or SDEC APPT REQUEST
; RIEN = IEN of the record of interest
; OUTPUT:
; 1st ^ Piece = IEN of VistA record identified
; 2nd ^ Piece = 0 node of File #409.86 for the identified record
;
I $G(RTU)="" S RTU=0
Q:REQT=""!("^R^A^RTC^C^P^V^"'[("^"_REQT_"^"))
Q:RIEN=""
;
S (CC,ROOT,REC,GMR,AR40985,RECALL)=""
; $O backwards to get the last entry entered if there are more than one entry in the x-ref
S CC=$O(^SDEC(409.86,"SRP",RIEN,""),-1)
I CC<1 D EXIT Q
S ROOT="" S ROOT=$P(^SDEC(409.86,CC,0),"^",7)
Q:$P(ROOT,";",1)'=RIEN
; Load 0 node for return
S REC="" S REC=^SDEC(409.86,CC,0)
; Check for SDEC CONTACT
I REQT="R" D
.S RECALL="" S RECALL=$G(^SD(403.5,RIEN,0))
.Q:RECALL=""
.Q:$P(REC,"^",1)'=$P(RECALL,"^",1)
.S RTU=CC_"^"_REC
.Q
; Check for SDEC APPT REQUEST
I (REQT="A")!(REQT="RTC")!(REQT="V") D
.S AR40985="" S AR40985=$G(^SDEC(409.85,RIEN,0))
.Q:AR40985=""
.Q:$P(REC,"^",1)'=$P(AR40985,"^",1)
.S RTU=CC_"^"_REC
.Q
; Check for REQUEST/CONSULTATION
I REQT="C"!(REQT="P") D
.S GMR="" S GMR=$G(^GMR(123,RIEN,0))
.Q:GMR=""
.Q:$P(REC,"^",1)'=$P(GMR,"^",2)
.Q:$P($G(REC),"^",1)'=$P($G(GMR),"^",2)
.S RTU=CC_"^"_REC
.Q
D EXIT
Q
;
DISMULT(RTT,CIEN) ;
; RPC: SDEC CONTACT MULTI-DISPLAY
Q:'$G(CIEN)
;
S (CC1,CC2,REC1,REC2,RTT,ENDT)=""
;
S CC2="" F S CC2=$O(^SDEC(409.86,CIEN,1,CC2)) Q:CC2="" D
.S REC2="" S REC2=$G(^SDEC(409.86,CIEN,1,CC2,1)) Q:REC2="" D
..S ENDT="" S ENDT=$P($G(^SDEC(409.86,CIEN,1,CC2,0)),"^",1)
..S (ENTU,ENTUN)="" S ENTUN=$P(REC2,"^",5) I ENTUN>0 D
...S ENTU=$$GET1^DIQ(200,ENTUN,.01,"E")
..S RTT=RTT_CC1_"^"_REC2_"^"_ENTU_"^"_ENDT_";"
..Q
D EXIT
Q
;
NEW(RET,DFN,CLI,DTP,REQT,SRV,DTCON,CONT,COM,DTENT,RIEN) ;
; RPC: SDEC CONTACT NEW
S RET=0
Q:'$G(DFN)
;Q:'$G(DTP)
Q:'$D(REQT)
Q:'$G(DTCON)
Q:'$D(CONT)
Q:'$G(DTENT)
Q:'$G(RIEN)
I '$D(COM) S COM=""
I '$G(CLI) S CLI=""
I '$G(SRV) S SRV=""
;
; Call SDES2 Add Contact RPC code
N ERRORS,DFN,CLINIC,PREFDATE,REQTYPE,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DTTMENTERED,REQUESTIEN,NEWCONTACT,RESULT,REQTYP
N NEWIEN,APPTREQTYPE,FDA,NEWCONTIEN,SUBIENS,CONTACTIEN,SEQUENCE,LEFTMSG,NEWCONTATTMTIEN,VALID,DIERR,CONTACT,DTMENTERED
;
; Build CONTACT array
S CONTACT("COMMENTS")=COM
S CONTACT("CONTACTTYPE")=CONT
S CONTACT("DTTMENTERED")=$$FMTISO^SDAMUTDT(DTENT)
S CONTACT("DTTMOFCONTACT")=$$FMTISO^SDAMUTDT(DTCON)
S CONTACT("LEFTMESSAGE")=0
S CONTACT("REQTYPE")=REQT
S CONTACT("REQUESTIEN")=RIEN
;
D REQUESTINFO^SDES2CONTACTS(.ERRORS,.CONTACT,.APPTREQTYPE,.REQUESTIEN,.REQTYP,.DFN,.CLINIC,.PREFDATE)
I $D(ERRORS) Q
;
D ASSIGNVARS^SDES2CONTACTS(.CONTACT,.REQTYPE,.DTTMOFCONTACT,.COMMENTS,.DTMENTERED,.LEFTMSG)
D VALIDATE^SDES2CONTACTS(.ERRORS,REQTYPE,.DTTMOFCONTACT,COMMENTS,.DTTMENTERED,LEFTMSG,CONTACTTYPE,CLINIC)
I $D(ERRORS) Q
;
D GETCONTACTIEN^SDES2CONTACTS(.CONTACTIEN,APPTREQTYPE)
D:(CONTACTIEN'="") UPDATECONTACT^SDES2CONTACTS(.RESULT,.FDA,CONTACTIEN,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DUZ,DTTMENTERED,LEFTMSG)
D:(CONTACTIEN="") CREATECONTACT^SDES2CONTACTS(.RESULT,.FDA,DFN,CONTACTIEN,CLINIC,PREFDATE,REQTYPE,APPTREQTYPE,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DUZ,DTTMENTERED,LEFTMSG)
D SAVECONTACT^SDES2CONTACTS(.ERRORS,.RESULT,.FDA,.NEWIEN)
I $D(ERRORS) Q
;End of SDES2 code
;
S RET=1
D EXIT
Q
SEQ(RE1,DF1,CL1,PDATE,RTYPE,SRR) ;
; RPC: SDEC CONTACT SEQUENCE
Q:'$G(DF1)
Q:'$G(PDATE)
I '$G(CL1) S CL1=""
I '$G(SRR) S SRR=""
;
S (JJ,JJ1,RCD,SQU,DF2)=""
S PDATE=$$NETTOFM^SDECDATE(PDATE,"N","N")
;
S JJ="" F S JJ=$O(^SDEC(409.86,"B",DF1,JJ)) Q:JJ="" D
.S RCD="" S RCD=$G(^SDEC(409.86,JJ,0)) Q:RCD="" D
..S SQU="" S SQU=$P($G(^SDEC(409.86,JJ,1,0)),"^",3) D
...Q:$G(SQU)=""
...Q:PDATE'=$P($G(RCD),"^",3)
...Q:RTYPE'=$P($G(RCD),"^",4)
...I $P($G(RCD),"^",2)=CL1 D
....S $P(^SDEC(409.86,JJ,0),"^",5)=SQU+1
....S RE1=SQU+1
....Q
...I $P($G(RCD),"^",6)=SRR D
....S $P(^SDEC(409.86,JJ,0),"^",5)=SQU+1
....S RE1=SQU+1
....Q
D EXIT
Q
;
SEQ1(RTU,REQT,RIEN) ;
; RPC: SDEC CONTACT SEQUENCE SINGLE
; INPUT: REQT = Request Type: SDEC CONTACT, REQUEST/CONSULTATION or SDEC APPT REQUEST
; RIEN = IEN of the record of interest
; OUTPUT:
; RTU = Newly created contact sequence number
I $G(RTU)="" S RTU=0
Q:REQT=""!("^R^A^RTC^C^P^V^"'[("^"_REQT_"^"))
Q:RIEN=""
;
; $O backwards to get the last entry entered if there are more than one entry in the x-ref
S CC=$O(^SDEC(409.86,"SRP",RIEN,""),-1)
I CC<1 D EXIT Q
S RCD=$G(^SDEC(409.86,CC,0)) Q:RCD=""
S SQU="" S SQU=$P($G(^SDEC(409.86,CC,1,0)),"^",3)
Q:$G(SQU)=""
Q:REQT'=$P($G(RCD),"^",4)
S RE1=SQU+1
S $P(^SDEC(409.86,CC,0),"^",5)=RE1
Q
;
UPDATE(RTT,IEN,CONDT,CTYPE,COMM,DTEN) ;
; RPC: SDEC CONTACT UPDATE
Q:'$G(IEN)
Q:'$G(CONDT)
Q:'$D(CTYPE)
I '$D(COMM) S COMM=""
I '$G(DTEN) S DTEN=""
;
; Call SDES2 Add Contact RPC code
N ERRORS,DFN,CLINIC,PREFDATE,REQTYPE,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DTTMENTERED,REQUESTIEN,NEWCONTACT,RESULT,REQTYP
N NEWIEN,APPTREQTYPE,FDA,NEWCONTIEN,SUBIENS,CONTACTIEN,SEQUENCE,LEFTMSG,NEWCONTATTMTIEN,VALID,DIERR,CONTACT,DTMENTERED
;
N SDCONREC
S SDCONREC=$G(^SDEC(409.86,IEN,0))
;
; Build CONTACT array
S CONTACT("COMMENTS")=COMM
S CONTACT("CONTACTTYPE")=CTYPE
I DTEN="" S DTEN=$$NOW^XLFDT()
S CONTACT("DTTMENTERED")=$$FMTISO^SDAMUTDT(DTEN)
S CONTACT("DTTMOFCONTACT")=$$FMTISO^SDAMUTDT(CONDT)
S CONTACT("REQTYPE")=$P(SDCONREC,"^",4)
S CONTACT("REQUESTIEN")=$P($P(SDCONREC,"^",7),";",1)
;
D REQUESTINFO^SDES2CONTACTS(.ERRORS,.CONTACT,.APPTREQTYPE,.REQUESTIEN,.REQTYP,.DFN,.CLINIC,.PREFDATE)
I $D(ERRORS) Q
;
D ASSIGNVARS^SDES2CONTACTS(.CONTACT,.REQTYPE,.DTTMOFCONTACT,.COMMENTS,.DTMENTERED,.LEFTMSG)
D VALIDATE^SDES2CONTACTS(.ERRORS,REQTYPE,.DTTMOFCONTACT,COMMENTS,.DTTMENTERED,LEFTMSG,CONTACTTYPE,CLINIC)
I $D(ERRORS) Q
;
D GETCONTACTIEN^SDES2CONTACTS(.CONTACTIEN,APPTREQTYPE)
D:(CONTACTIEN'="") UPDATECONTACT^SDES2CONTACTS(.RESULT,.FDA,CONTACTIEN,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DUZ,DTTMENTERED,LEFTMSG)
D:(CONTACTIEN="") CREATECONTACT^SDES2CONTACTS(.RESULT,.FDA,DFN,CONTACTIEN,CLINIC,PREFDATE,REQTYPE,APPTREQTYPE,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DUZ,DTTMENTERED,LEFTMSG)
D SAVECONTACT^SDES2CONTACTS(.ERRORS,.RESULT,.FDA,.NEWIEN)
I $D(ERRORS) Q
;End of SDES2 code
D EXIT
Q
GETSTC(RET,CLIEN) ;
; RPC: SDEC CONTACT STOP CODE
Q:CLIEN=""
;
;CLIEN=Clinic IEN
;HLF0=Hospital Location File 0 node
;SNUM=Stopc Code IEN [0,7]
;STPC=Stop Code 40.7
;CSNUM=Credit Stop IEN [0,18]
;CSTPC=Credit Stop Code 40.7
;
S (HLF0,SNUM,STPC,CSNUM,CSTPC,CNUM)=""
;
S HLF0=$G(^SC(CLIEN,0)) I HLF0'="" D
.S SNUM=$P($G(HLF0),"^",7) I SNUM'="" D
..S STPC=$$GET1^DIQ(40.7,SNUM,1)
.S CNUM=$P($G(HLF0),"^",18) I CNUM'="" D
..S CSTPC=$$GET1^DIQ(40.7,CNUM,1)
S RET=STPC_"^"_CSTPC
K HLF0,SNUM,STPC,CSNUM,CSTPC,CNUM
Q
EXIT ;
K MULT,CC,CCC,COUNT,COMM,DTEN,ENDT,AR40985,RECALL,ROOT,GMR
K JJ,JJ1,RCD,SQU,DF2,DFN2,CC1,CC2,RCD,SQU,ENTU,ENTUN
K REC,REC1,REC2,ENDT,MULTN,CLN,PDT,REQT,SER,RIEN,SDRIEN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECCON 8090 printed Jan 29, 2026@15:50:49 Page 2
SDECCON ;SPFO/DMR,MGD,RRM,TAW - SCHEDULING ENHANCEMENTS VSE CONTACT API ;OCT 16, 2025
+1 ;;5.3;Scheduling;**669,686,781,785,827,922**;Aug 13 1993;Build 7
+2 ;
+3 ;This API provides SDEC CONTACT(#409.86)file information to the VSE VS GUI.
+4 ; 3/6/18 - wtc/zeb Added new cross-reference for audit statistics compiler. Patch 686
+5 ;
+6 QUIT
DISPLAY(RTU,DFN,CLN,PDT,REQT,SER) ;
+1 ; RPC: SDEC CONTACT DISPLAY
+2 if '$GET(DFN)
QUIT
+3 if '$GET(PDT)
QUIT
+4 if '$DATA(REQT)
QUIT
+5 SET (CC,CC1,CC2,REC)=""
+6 ;
+7 ;CONVERT TO FILEMAN DATE
SET PDT=$$NETTOFM^SDECDATE(PDT,"N","N")
+8 ;
+9 SET CC=""
FOR
SET CC=$ORDER(^SDEC(409.86,"B",DFN,CC))
if CC=""
QUIT
Begin DoDot:1
+10 SET REC=""
SET REC=^SDEC(409.86,CC,0)
+11 if PDT'=$PIECE($GET(REC),"^",3)
QUIT
+12 IF $GET(CLN)'=""
if $GET(CLN)'=$PIECE($GET(REC),"^",2)
QUIT
+13 IF $GET(SER)'=""
if $GET(SER)'=$PIECE($GET(REC),"^",6)
QUIT
+14 if REQT'=$PIECE($GET(REC),"^",4)
QUIT
+15 SET RTU=CC_"^"_REC
+16 QUIT
End DoDot:1
+17 DO EXIT
+18 QUIT
+19 ;
DISPLAY1(RTU,REQT,RIEN) ;
+1 ; RPC: SDEC CONTACT DISPLAY SINGLE
+2 ; INPUT: REQT = Request Type: SDEC CONTACT, REQUEST/CONSULTATION or SDEC APPT REQUEST
+3 ; RIEN = IEN of the record of interest
+4 ; OUTPUT:
+5 ; 1st ^ Piece = IEN of VistA record identified
+6 ; 2nd ^ Piece = 0 node of File #409.86 for the identified record
+7 ;
+8 IF $GET(RTU)=""
SET RTU=0
+9 if REQT=""!("^R^A^RTC^C^P^V^"'[("^"_REQT_"^"))
QUIT
+10 if RIEN=""
QUIT
+11 ;
+12 SET (CC,ROOT,REC,GMR,AR40985,RECALL)=""
+13 ; $O backwards to get the last entry entered if there are more than one entry in the x-ref
+14 SET CC=$ORDER(^SDEC(409.86,"SRP",RIEN,""),-1)
+15 IF CC<1
DO EXIT
QUIT
+16 SET ROOT=""
SET ROOT=$PIECE(^SDEC(409.86,CC,0),"^",7)
+17 if $PIECE(ROOT,";",1)'=RIEN
QUIT
+18 ; Load 0 node for return
+19 SET REC=""
SET REC=^SDEC(409.86,CC,0)
+20 ; Check for SDEC CONTACT
+21 IF REQT="R"
Begin DoDot:1
+22 SET RECALL=""
SET RECALL=$GET(^SD(403.5,RIEN,0))
+23 if RECALL=""
QUIT
+24 if $PIECE(REC,"^",1)'=$PIECE(RECALL,"^",1)
QUIT
+25 SET RTU=CC_"^"_REC
+26 QUIT
End DoDot:1
+27 ; Check for SDEC APPT REQUEST
+28 IF (REQT="A")!(REQT="RTC")!(REQT="V")
Begin DoDot:1
+29 SET AR40985=""
SET AR40985=$GET(^SDEC(409.85,RIEN,0))
+30 if AR40985=""
QUIT
+31 if $PIECE(REC,"^",1)'=$PIECE(AR40985,"^",1)
QUIT
+32 SET RTU=CC_"^"_REC
+33 QUIT
End DoDot:1
+34 ; Check for REQUEST/CONSULTATION
+35 IF REQT="C"!(REQT="P")
Begin DoDot:1
+36 SET GMR=""
SET GMR=$GET(^GMR(123,RIEN,0))
+37 if GMR=""
QUIT
+38 if $PIECE(REC,"^",1)'=$PIECE(GMR,"^",2)
QUIT
+39 if $PIECE($GET(REC),"^",1)'=$PIECE($GET(GMR),"^",2)
QUIT
+40 SET RTU=CC_"^"_REC
+41 QUIT
End DoDot:1
+42 DO EXIT
+43 QUIT
+44 ;
DISMULT(RTT,CIEN) ;
+1 ; RPC: SDEC CONTACT MULTI-DISPLAY
+2 if '$GET(CIEN)
QUIT
+3 ;
+4 SET (CC1,CC2,REC1,REC2,RTT,ENDT)=""
+5 ;
+6 SET CC2=""
FOR
SET CC2=$ORDER(^SDEC(409.86,CIEN,1,CC2))
if CC2=""
QUIT
Begin DoDot:1
+7 SET REC2=""
SET REC2=$GET(^SDEC(409.86,CIEN,1,CC2,1))
if REC2=""
QUIT
Begin DoDot:2
+8 SET ENDT=""
SET ENDT=$PIECE($GET(^SDEC(409.86,CIEN,1,CC2,0)),"^",1)
+9 SET (ENTU,ENTUN)=""
SET ENTUN=$PIECE(REC2,"^",5)
IF ENTUN>0
Begin DoDot:3
+10 SET ENTU=$$GET1^DIQ(200,ENTUN,.01,"E")
End DoDot:3
+11 SET RTT=RTT_CC1_"^"_REC2_"^"_ENTU_"^"_ENDT_";"
+12 QUIT
End DoDot:2
End DoDot:1
+13 DO EXIT
+14 QUIT
+15 ;
NEW(RET,DFN,CLI,DTP,REQT,SRV,DTCON,CONT,COM,DTENT,RIEN) ;
+1 ; RPC: SDEC CONTACT NEW
+2 SET RET=0
+3 if '$GET(DFN)
QUIT
+4 ;Q:'$G(DTP)
+5 if '$DATA(REQT)
QUIT
+6 if '$GET(DTCON)
QUIT
+7 if '$DATA(CONT)
QUIT
+8 if '$GET(DTENT)
QUIT
+9 if '$GET(RIEN)
QUIT
+10 IF '$DATA(COM)
SET COM=""
+11 IF '$GET(CLI)
SET CLI=""
+12 IF '$GET(SRV)
SET SRV=""
+13 ;
+14 ; Call SDES2 Add Contact RPC code
+15 NEW ERRORS,DFN,CLINIC,PREFDATE,REQTYPE,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DTTMENTERED,REQUESTIEN,NEWCONTACT,RESULT,REQTYP
+16 NEW NEWIEN,APPTREQTYPE,FDA,NEWCONTIEN,SUBIENS,CONTACTIEN,SEQUENCE,LEFTMSG,NEWCONTATTMTIEN,VALID,DIERR,CONTACT,DTMENTERED
+17 ;
+18 ; Build CONTACT array
+19 SET CONTACT("COMMENTS")=COM
+20 SET CONTACT("CONTACTTYPE")=CONT
+21 SET CONTACT("DTTMENTERED")=$$FMTISO^SDAMUTDT(DTENT)
+22 SET CONTACT("DTTMOFCONTACT")=$$FMTISO^SDAMUTDT(DTCON)
+23 SET CONTACT("LEFTMESSAGE")=0
+24 SET CONTACT("REQTYPE")=REQT
+25 SET CONTACT("REQUESTIEN")=RIEN
+26 ;
+27 DO REQUESTINFO^SDES2CONTACTS(.ERRORS,.CONTACT,.APPTREQTYPE,.REQUESTIEN,.REQTYP,.DFN,.CLINIC,.PREFDATE)
+28 IF $DATA(ERRORS)
QUIT
+29 ;
+30 DO ASSIGNVARS^SDES2CONTACTS(.CONTACT,.REQTYPE,.DTTMOFCONTACT,.COMMENTS,.DTMENTERED,.LEFTMSG)
+31 DO VALIDATE^SDES2CONTACTS(.ERRORS,REQTYPE,.DTTMOFCONTACT,COMMENTS,.DTTMENTERED,LEFTMSG,CONTACTTYPE,CLINIC)
+32 IF $DATA(ERRORS)
QUIT
+33 ;
+34 DO GETCONTACTIEN^SDES2CONTACTS(.CONTACTIEN,APPTREQTYPE)
+35 if (CONTACTIEN'="")
DO UPDATECONTACT^SDES2CONTACTS(.RESULT,.FDA,CONTACTIEN,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DUZ,DTTMENTERED,LEFTMSG)
+36 if (CONTACTIEN="")
DO CREATECONTACT^SDES2CONTACTS(.RESULT,.FDA,DFN,CONTACTIEN,CLINIC,PREFDATE,REQTYPE,APPTREQTYPE,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DUZ,DTTMENTERED,LEFTMSG)
+37 DO SAVECONTACT^SDES2CONTACTS(.ERRORS,.RESULT,.FDA,.NEWIEN)
+38 IF $DATA(ERRORS)
QUIT
+39 ;End of SDES2 code
+40 ;
+41 SET RET=1
+42 DO EXIT
+43 QUIT
SEQ(RE1,DF1,CL1,PDATE,RTYPE,SRR) ;
+1 ; RPC: SDEC CONTACT SEQUENCE
+2 if '$GET(DF1)
QUIT
+3 if '$GET(PDATE)
QUIT
+4 IF '$GET(CL1)
SET CL1=""
+5 IF '$GET(SRR)
SET SRR=""
+6 ;
+7 SET (JJ,JJ1,RCD,SQU,DF2)=""
+8 SET PDATE=$$NETTOFM^SDECDATE(PDATE,"N","N")
+9 ;
+10 SET JJ=""
FOR
SET JJ=$ORDER(^SDEC(409.86,"B",DF1,JJ))
if JJ=""
QUIT
Begin DoDot:1
+11 SET RCD=""
SET RCD=$GET(^SDEC(409.86,JJ,0))
if RCD=""
QUIT
Begin DoDot:2
+12 SET SQU=""
SET SQU=$PIECE($GET(^SDEC(409.86,JJ,1,0)),"^",3)
Begin DoDot:3
+13 if $GET(SQU)=""
QUIT
+14 if PDATE'=$PIECE($GET(RCD),"^",3)
QUIT
+15 if RTYPE'=$PIECE($GET(RCD),"^",4)
QUIT
+16 IF $PIECE($GET(RCD),"^",2)=CL1
Begin DoDot:4
+17 SET $PIECE(^SDEC(409.86,JJ,0),"^",5)=SQU+1
+18 SET RE1=SQU+1
+19 QUIT
End DoDot:4
+20 IF $PIECE($GET(RCD),"^",6)=SRR
Begin DoDot:4
+21 SET $PIECE(^SDEC(409.86,JJ,0),"^",5)=SQU+1
+22 SET RE1=SQU+1
+23 QUIT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+24 DO EXIT
+25 QUIT
+26 ;
SEQ1(RTU,REQT,RIEN) ;
+1 ; RPC: SDEC CONTACT SEQUENCE SINGLE
+2 ; INPUT: REQT = Request Type: SDEC CONTACT, REQUEST/CONSULTATION or SDEC APPT REQUEST
+3 ; RIEN = IEN of the record of interest
+4 ; OUTPUT:
+5 ; RTU = Newly created contact sequence number
+6 IF $GET(RTU)=""
SET RTU=0
+7 if REQT=""!("^R^A^RTC^C^P^V^"'[("^"_REQT_"^"))
QUIT
+8 if RIEN=""
QUIT
+9 ;
+10 ; $O backwards to get the last entry entered if there are more than one entry in the x-ref
+11 SET CC=$ORDER(^SDEC(409.86,"SRP",RIEN,""),-1)
+12 IF CC<1
DO EXIT
QUIT
+13 SET RCD=$GET(^SDEC(409.86,CC,0))
if RCD=""
QUIT
+14 SET SQU=""
SET SQU=$PIECE($GET(^SDEC(409.86,CC,1,0)),"^",3)
+15 if $GET(SQU)=""
QUIT
+16 if REQT'=$PIECE($GET(RCD),"^",4)
QUIT
+17 SET RE1=SQU+1
+18 SET $PIECE(^SDEC(409.86,CC,0),"^",5)=RE1
+19 QUIT
+20 ;
UPDATE(RTT,IEN,CONDT,CTYPE,COMM,DTEN) ;
+1 ; RPC: SDEC CONTACT UPDATE
+2 if '$GET(IEN)
QUIT
+3 if '$GET(CONDT)
QUIT
+4 if '$DATA(CTYPE)
QUIT
+5 IF '$DATA(COMM)
SET COMM=""
+6 IF '$GET(DTEN)
SET DTEN=""
+7 ;
+8 ; Call SDES2 Add Contact RPC code
+9 NEW ERRORS,DFN,CLINIC,PREFDATE,REQTYPE,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DTTMENTERED,REQUESTIEN,NEWCONTACT,RESULT,REQTYP
+10 NEW NEWIEN,APPTREQTYPE,FDA,NEWCONTIEN,SUBIENS,CONTACTIEN,SEQUENCE,LEFTMSG,NEWCONTATTMTIEN,VALID,DIERR,CONTACT,DTMENTERED
+11 ;
+12 NEW SDCONREC
+13 SET SDCONREC=$GET(^SDEC(409.86,IEN,0))
+14 ;
+15 ; Build CONTACT array
+16 SET CONTACT("COMMENTS")=COMM
+17 SET CONTACT("CONTACTTYPE")=CTYPE
+18 IF DTEN=""
SET DTEN=$$NOW^XLFDT()
+19 SET CONTACT("DTTMENTERED")=$$FMTISO^SDAMUTDT(DTEN)
+20 SET CONTACT("DTTMOFCONTACT")=$$FMTISO^SDAMUTDT(CONDT)
+21 SET CONTACT("REQTYPE")=$PIECE(SDCONREC,"^",4)
+22 SET CONTACT("REQUESTIEN")=$PIECE($PIECE(SDCONREC,"^",7),";",1)
+23 ;
+24 DO REQUESTINFO^SDES2CONTACTS(.ERRORS,.CONTACT,.APPTREQTYPE,.REQUESTIEN,.REQTYP,.DFN,.CLINIC,.PREFDATE)
+25 IF $DATA(ERRORS)
QUIT
+26 ;
+27 DO ASSIGNVARS^SDES2CONTACTS(.CONTACT,.REQTYPE,.DTTMOFCONTACT,.COMMENTS,.DTMENTERED,.LEFTMSG)
+28 DO VALIDATE^SDES2CONTACTS(.ERRORS,REQTYPE,.DTTMOFCONTACT,COMMENTS,.DTTMENTERED,LEFTMSG,CONTACTTYPE,CLINIC)
+29 IF $DATA(ERRORS)
QUIT
+30 ;
+31 DO GETCONTACTIEN^SDES2CONTACTS(.CONTACTIEN,APPTREQTYPE)
+32 if (CONTACTIEN'="")
DO UPDATECONTACT^SDES2CONTACTS(.RESULT,.FDA,CONTACTIEN,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DUZ,DTTMENTERED,LEFTMSG)
+33 if (CONTACTIEN="")
DO CREATECONTACT^SDES2CONTACTS(.RESULT,.FDA,DFN,CONTACTIEN,CLINIC,PREFDATE,REQTYPE,APPTREQTYPE,DTTMOFCONTACT,CONTACTTYPE,COMMENTS,DUZ,DTTMENTERED,LEFTMSG)
+34 DO SAVECONTACT^SDES2CONTACTS(.ERRORS,.RESULT,.FDA,.NEWIEN)
+35 IF $DATA(ERRORS)
QUIT
+36 ;End of SDES2 code
+37 DO EXIT
+38 QUIT
GETSTC(RET,CLIEN) ;
+1 ; RPC: SDEC CONTACT STOP CODE
+2 if CLIEN=""
QUIT
+3 ;
+4 ;CLIEN=Clinic IEN
+5 ;HLF0=Hospital Location File 0 node
+6 ;SNUM=Stopc Code IEN [0,7]
+7 ;STPC=Stop Code 40.7
+8 ;CSNUM=Credit Stop IEN [0,18]
+9 ;CSTPC=Credit Stop Code 40.7
+10 ;
+11 SET (HLF0,SNUM,STPC,CSNUM,CSTPC,CNUM)=""
+12 ;
+13 SET HLF0=$GET(^SC(CLIEN,0))
IF HLF0'=""
Begin DoDot:1
+14 SET SNUM=$PIECE($GET(HLF0),"^",7)
IF SNUM'=""
Begin DoDot:2
+15 SET STPC=$$GET1^DIQ(40.7,SNUM,1)
End DoDot:2
+16 SET CNUM=$PIECE($GET(HLF0),"^",18)
IF CNUM'=""
Begin DoDot:2
+17 SET CSTPC=$$GET1^DIQ(40.7,CNUM,1)
End DoDot:2
End DoDot:1
+18 SET RET=STPC_"^"_CSTPC
+19 KILL HLF0,SNUM,STPC,CSNUM,CSTPC,CNUM
+20 QUIT
EXIT ;
+1 KILL MULT,CC,CCC,COUNT,COMM,DTEN,ENDT,AR40985,RECALL,ROOT,GMR
+2 KILL JJ,JJ1,RCD,SQU,DF2,DFN2,CC1,CC2,RCD,SQU,ENTU,ENTUN
+3 KILL REC,REC1,REC2,ENDT,MULTN,CLN,PDT,REQT,SER,RIEN,SDRIEN
+4 QUIT
