SDECCON ;SPFO/DMR,MGD,RRM SCHEDULING ENHANCEMENTS VSE CONTACT API ;Mar 31, 2021@09:59
;;5.3;Scheduling;**669,686,781,785,827**;Aug 13 1993;Build 10
;
;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=""
S DTP=$$NETTOFM^SDECDATE(DTP,"N","N") ;CONVERT TO FILEMAN DATE
;
; Determine variable pointer file
S SDRIEN=""
I RIEN>0 D
. I (REQT="A")!(REQT="RTC")!(REQT="V") D
. . Q:$P($G(^SDEC(409.85,RIEN,0)),U,1)'=DFN
. . Q:($P($G(^SDEC(409.85,RIEN,0)),U,5)'="APPT"&($P($G(^SDEC(409.85,RIEN,0)),U,5)'="RTC"))&($P($G(^SDEC(409.85,RIEN,0)),U,5)'="VETERAN")
. . S SDRIEN=RIEN_";"_"SDEC(409.85," Q
. Q:SDRIEN'=""
. I REQT="C"!(REQT="P") D
. . Q:$P($G(^GMR(123,RIEN,0)),U,2)'=DFN
. . Q:$P($G(^GMR(123,RIEN,0)),U,17)'=REQT
. . Q:CLI'=""&(CLI'=$P(^GMR(123,RIEN,0),U,4))
. . S SDRIEN=RIEN_";"_"GMR(123," Q
. Q:SDRIEN'=""
. I REQT="R" D
. . Q:$P($G(^SD(403.5,RIEN,0)),U,1)'=DFN
. . Q:$P($G(^SD(403.5,RIEN,0)),U,2)'=CLI
. . S SDRIEN=RIEN_";"_"SD(403.5,"
. Q
;
S (DFN2,CC1,CC2)=""
;
S DFN2="" F S DFN2=$O(^SDEC(409.86,"B",DFN2)) Q:DFN2="" D
.S CC1="" F S CC1=$O(^SDEC(409.86,"B",DFN2,CC1)) Q:CC1="" D
..S CC2=CC2+1
..Q
S CC2=CC2+1 D
.S ^SDEC(409.86,0)="SDEC CONTACT^409.86P^"_CC2_"^"_CC2
.S ^SDEC(409.86,CC2,0)=DFN_"^"_CLI_"^"_DTP_"^"_REQT_"^"_1_"^"_SRV
.S ^SDEC(409.86,CC2,1,0)="^409.863D^1^1"
.S ^SDEC(409.86,CC2,1,1,0)=DTCON
.S ^SDEC(409.86,CC2,1,1,1)=CONT_"^"_COM_"^"_0_"^"_1_"^"_DUZ_"^"_DTENT
.S ^SDEC(409.86,"B",DFN,CC2)=""
.S ^SDEC(409.86,CC2,1,"B",DTCON,1)=""
.S ^SDEC(409.86,"AD",DTENT,DUZ,CC2,1)="" ; 3/6/18 WTC/ZEB create date/user cross-reference.
.I SDRIEN'="" S $P(^SDEC(409.86,CC2,0),U,7)=SDRIEN ; APPT REQUEST TYPE (#2.3)
.; Build the SRP x-ref
.N DIK,DA
.S DIK="^SDEC(409.86,",DA=CC2,DIK(1)=2.3
.D EN1^DIK
.Q
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=""
;
S (MULT,RTT,CC,CCC,COUNT,MULTN)=""
;
S MULT="" S MULT=$G(^SDEC(409.86,IEN,1,0)) I MULT'="" D
.S MULTN=$P(MULT,"^",4) I MULTN'="" D
..S COUNT=MULTN
.Q
I COUNT'="" S COUNT=COUNT+1 D
.S ^SDEC(409.86,IEN,1,0)="^409.863D^"_COUNT_"^"_COUNT
.S ^SDEC(409.86,IEN,1,COUNT,0)=CONDT
.S ^SDEC(409.86,IEN,1,COUNT,1)=CTYPE_"^"_COMM_"^"_0_"^"_COUNT_"^"_DUZ_"^"_DTEN
.S ^SDEC(409.86,IEN,1,"B",CONDT,COUNT)=""
.S ^SDEC(409.86,"AD",DTEN,DUZ,IEN,COUNT)="" ; 3/6/18 WTC/ZEB create date/user cross-reference.
.Q
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 7344 printed Oct 16, 2024@18:52:25 Page 2
SDECCON ;SPFO/DMR,MGD,RRM SCHEDULING ENHANCEMENTS VSE CONTACT API ;Mar 31, 2021@09:59
+1 ;;5.3;Scheduling;**669,686,781,785,827**;Aug 13 1993;Build 10
+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 if '$GET(DTP)
QUIT
+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 ;CONVERT TO FILEMAN DATE
SET DTP=$$NETTOFM^SDECDATE(DTP,"N","N")
+14 ;
+15 ; Determine variable pointer file
+16 SET SDRIEN=""
+17 IF RIEN>0
Begin DoDot:1
+18 IF (REQT="A")!(REQT="RTC")!(REQT="V")
Begin DoDot:2
+19 if $PIECE($GET(^SDEC(409.85,RIEN,0)),U,1)'=DFN
QUIT
+20 if ($PIECE($GET(^SDEC(409.85,RIEN,0)),U,5)'="APPT"&($PIECE($GET(^SDEC(409.85,RIEN,0)),U,5)'="RTC"))&($PIECE($GET(^SDEC(409.85,RIEN,0)),U,5)'="VETERAN")
QUIT
+21 SET SDRIEN=RIEN_";"_"SDEC(409.85,"
QUIT
End DoDot:2
+22 if SDRIEN'=""
QUIT
+23 IF REQT="C"!(REQT="P")
Begin DoDot:2
+24 if $PIECE($GET(^GMR(123,RIEN,0)),U,2)'=DFN
QUIT
+25 if $PIECE($GET(^GMR(123,RIEN,0)),U,17)'=REQT
QUIT
+26 if CLI'=""&(CLI'=$PIECE(^GMR(123,RIEN,0),U,4))
QUIT
+27 SET SDRIEN=RIEN_";"_"GMR(123,"
QUIT
End DoDot:2
+28 if SDRIEN'=""
QUIT
+29 IF REQT="R"
Begin DoDot:2
+30 if $PIECE($GET(^SD(403.5,RIEN,0)),U,1)'=DFN
QUIT
+31 if $PIECE($GET(^SD(403.5,RIEN,0)),U,2)'=CLI
QUIT
+32 SET SDRIEN=RIEN_";"_"SD(403.5,"
End DoDot:2
+33 QUIT
End DoDot:1
+34 ;
+35 SET (DFN2,CC1,CC2)=""
+36 ;
+37 SET DFN2=""
FOR
SET DFN2=$ORDER(^SDEC(409.86,"B",DFN2))
if DFN2=""
QUIT
Begin DoDot:1
+38 SET CC1=""
FOR
SET CC1=$ORDER(^SDEC(409.86,"B",DFN2,CC1))
if CC1=""
QUIT
Begin DoDot:2
+39 SET CC2=CC2+1
+40 QUIT
End DoDot:2
End DoDot:1
+41 SET CC2=CC2+1
Begin DoDot:1
+42 SET ^SDEC(409.86,0)="SDEC CONTACT^409.86P^"_CC2_"^"_CC2
+43 SET ^SDEC(409.86,CC2,0)=DFN_"^"_CLI_"^"_DTP_"^"_REQT_"^"_1_"^"_SRV
+44 SET ^SDEC(409.86,CC2,1,0)="^409.863D^1^1"
+45 SET ^SDEC(409.86,CC2,1,1,0)=DTCON
+46 SET ^SDEC(409.86,CC2,1,1,1)=CONT_"^"_COM_"^"_0_"^"_1_"^"_DUZ_"^"_DTENT
+47 SET ^SDEC(409.86,"B",DFN,CC2)=""
+48 SET ^SDEC(409.86,CC2,1,"B",DTCON,1)=""
+49 ; 3/6/18 WTC/ZEB create date/user cross-reference.
SET ^SDEC(409.86,"AD",DTENT,DUZ,CC2,1)=""
+50 ; APPT REQUEST TYPE (#2.3)
IF SDRIEN'=""
SET $PIECE(^SDEC(409.86,CC2,0),U,7)=SDRIEN
+51 ; Build the SRP x-ref
+52 NEW DIK,DA
+53 SET DIK="^SDEC(409.86,"
SET DA=CC2
SET DIK(1)=2.3
+54 DO EN1^DIK
+55 QUIT
End DoDot:1
+56 SET RET=1
+57 DO EXIT
+58 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 SET (MULT,RTT,CC,CCC,COUNT,MULTN)=""
+9 ;
+10 SET MULT=""
SET MULT=$GET(^SDEC(409.86,IEN,1,0))
IF MULT'=""
Begin DoDot:1
+11 SET MULTN=$PIECE(MULT,"^",4)
IF MULTN'=""
Begin DoDot:2
+12 SET COUNT=MULTN
End DoDot:2
+13 QUIT
End DoDot:1
+14 IF COUNT'=""
SET COUNT=COUNT+1
Begin DoDot:1
+15 SET ^SDEC(409.86,IEN,1,0)="^409.863D^"_COUNT_"^"_COUNT
+16 SET ^SDEC(409.86,IEN,1,COUNT,0)=CONDT
+17 SET ^SDEC(409.86,IEN,1,COUNT,1)=CTYPE_"^"_COMM_"^"_0_"^"_COUNT_"^"_DUZ_"^"_DTEN
+18 SET ^SDEC(409.86,IEN,1,"B",CONDT,COUNT)=""
+19 ; 3/6/18 WTC/ZEB create date/user cross-reference.
SET ^SDEC(409.86,"AD",DTEN,DUZ,IEN,COUNT)=""
+20 QUIT
End DoDot:1
+21 DO EXIT
+22 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
