SDEC52B ;ALB/MGD/ANU,TJB - VISTA SCHEDULING RPCS ;oct 20, 2022
;;5.3;Scheduling;**627,796,797,827,877**;Aug 13, 1993;Build 14
;;Per VHA Directive 6402, this routine should not be modified
;
; Reference to ^VA(200 in ICR #10060
;
Q
;
RECAPGET(SDECY) ; GET entries from the RECALL REMINDERS APPT TYPE file 403.51
;RECAPGET(SDECY) external parameter tag is in SDEC
;INPUT: none
;RETURN:
; Successful Return:
; Global Array in which each array entry contains Recall Reminders Appt
; type names from the RECALL REMINDERS APPT TYPE file 403.51
; Data is separated by ^:
; 1. RECALL REMINDERS APPT TYPE ien
; 2. RECALL REMINDERS APPT TYPE name
; Caught Exception Return:
; A single entry in the Global Array in the format "-1^<error text>"
; "T00020RETURNCODE^T00100TEXT"
; Unexpected Exception Return:
; Handled by the RPC Broker.
; M errors are trapped by the use of M and Kernel error handling.
; The RPC execution stops and the RPC Broker sends the error generated
; text back to the client.
;
N NAME,SDECI,SDI
S SDECI=0
K ^TMP("SDEC52",$J,"RECAPGET")
S SDECY="^TMP(""SDEC52"","_$J_",""RECAPGET"")"
; data header
S @SDECY@(SDECI)="T00030RRAPPTYP^T00030RRAPPTYPN"_$C(30)
S SDI=0 F S SDI=$O(^SD(403.51,SDI)) Q:SDI'>0 D
.S NAME=$$GET1^DIQ(403.51,SDI_",",.01) ; $P($G(^SD(403.51,SDI,0)),U,1)
.S SDECI=SDECI+1 S @SDECY@(SDECI)=SDI_U_NAME_$C(30)
S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
Q
;
RECPRGET(SDECY,RECINACT,SDECP,MAXREC,LASTSUB) ; GET entries from the RECALL REMINDERS PROVIDERS file 403.54
;RECAPGET(SDECY,RECINACT) external parameter tag is in SDEC
;INPUT:
; RECINACT - flag to include inactive providers
; SDECP - (optional) Partial name text
; MAXREC - (optional) Max records returned
; LASTSUB - (optional) last subscripts from previous call
;RETURN:
; Successful Return:
; Global Array in which each array entry contains data from RECALL REMINDERS PROVIDERS file 403.54.
; Data is separated by ^:
; 1. IEN - Pointer to RECALL REMINDERS PROVIDERS file
; 2. Provider IEN - Pointer to NEW PERSON file
; 3. Provider Name - NAME from NEW PERSON file
; 4. Team ID - Pointer to RECALL REMINDERS TEAM file 403.55
; 5. Team Name - NAME from RECALL REMINDERS TEAM file 403.55
; 6. Division ID - Pointer to MEDICAL CENTER DIVISION file 40.8
; 7. Division Name - NAME from MEDICAL CENTER DIVISION file 40.8
; 8. Direct Phone - Free-Text 7-14 Characters
; 9. EXT. - Free-Text 4-20 characters
; 10. Status - Valid values are:
; ACTIVE
; INACTIVE
; 11. Security Key ID - Pointer to SECURITY KEY file 19.1
; 12. Security Key Name - NAME from SECURITY KEY file 19.1
; 13. LASTSUB - Subscripts from last call
; Caught Exception Return:
; A single entry in the Global Array in the format "-1^<error text>"
; "T00020RETURNCODE^T00100TEXT"
; Unexpected Exception Return:
; Handled by the RPC Broker.
; M errors are trapped by the use of M and Kernel error handling.
; The RPC execution stops and the RPC Broker sends the error generated
; text back to the client.
;
N LSUB,PRVDATA,SDCNT,SDECI,SDI,SDJ,SDK,SDTMP
S (SDI,SDJ,SDK)=""
S (SDCNT,SDECI)=0
K ^TMP("RECDATA",$J)
S RECINACT=$G(RECINACT)
I RECINACT="" S RECINACT=0
K ^TMP("SDEC52",$J,"RECPRGET")
S SDECY="^TMP(""SDEC52"","_$J_",""RECPRGET"")"
; data header
S SDTMP="T00030RRPROVIEN^T00030PROVIEN^T00030PROVNAME^T00030TEAMID^T00030TEAMNAME^T00030DIVIEN"
S SDTMP=SDTMP_"^T00030DIVNAME^T00030PTELEPHONE^T00020EXT^T00010RRPSTATUS^T00020KEYIEN^T00030KEYNAME"
S SDTMP=SDTMP_"^T00030LASTSUB"
S @SDECY@(SDECI)=SDTMP_$C(30)
S SDECP=$G(SDECP)
S MAXREC=$G(MAXREC,200) S:MAXREC="" MAXREC=200
S LASTSUB=$G(LASTSUB)
I SDECP'="" D
.S SDK=$S($P(LASTSUB,"|",1)'="":$$GETSUB^SDECU($P(LASTSUB,"|",1)),1:$$GETSUB^SDECU(SDECP))
.F S SDK=$O(^VA(200,"B",SDK)) Q:SDK="" Q:SDK'[SDECP D Q:SDCNT'<MAXREC
..S SDJ=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,1:0)
..F S SDJ=$O(^VA(200,"B",SDK,SDJ)) Q:SDJ'>0 D Q:SDCNT'<MAXREC
...S SDI=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
...F S SDI=$O(^SD(403.54,"B",SDJ,SDI)) Q:SDI'>0 D GET1PR(SDI,RECINACT,.SDCNT) Q:SDCNT'<MAXREC
E S SDI=0 F S SDI=$O(^SD(403.54,SDI)) Q:SDI'>0 D GET1PR(SDI,RECINACT,.SDCNT)
N PRVNAME
S PRVNAME=""
F S PRVNAME=$O(^TMP("RECDATA",$J,PRVNAME)) Q:PRVNAME="" D
.S PRVDATA=$G(^TMP("RECDATA",$J,PRVNAME))
.S SDECI=SDECI+1
.S @SDECY@(SDECI)=PRVDATA_$C(30)
.S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
I SDCNT'<MAXREC,SDECP'="",SDK[SDECP D
.S SDTMP=$P(@SDECY@(SDECI),$C(30,31),1)
.S $P(SDTMP,U,13)=SDK_"|"_SDJ_"|"_SDI
.S @SDECY@(SDECI)=SDTMP_$C(30,31)
K ^TMP("RECDATA",$J)
Q
GET1PR(SDI,RECINACT,SDCNT) ;
N SDDATA,SDMSG,SDTERM
N RRPSTATUS,DIVIEN,DIVNAME,EXT,KEYIEN,KEYNAME,PROVIEN,PROVNAME,TEAMID,TEAMNAME,PTELE
D GETS^DIQ(403.54,SDI,"**","IE","SDDATA","SDMSG")
S PROVIEN=SDDATA(403.54,SDI_",",.01,"I")
S PROVNAME=SDDATA(403.54,SDI_",",.01,"E")
S TEAMID=SDDATA(403.54,SDI_",",1,"I")
S TEAMNAME=SDDATA(403.54,SDI_",",1,"E")
S DIVIEN=SDDATA(403.54,SDI_",",2,"I")
S DIVNAME=SDDATA(403.54,SDI_",",2,"E")
S PTELE=SDDATA(403.54,SDI_",",3,"I")
S EXT=SDDATA(403.54,SDI_",",4,"I")
S RRPSTATUS=SDDATA(403.54,SDI_",",5,"E")
S KEYIEN=SDDATA(403.54,SDI_",",6,"I")
S KEYNAME=SDDATA(403.54,SDI_",",6,"E")
Q:RRPSTATUS="INACTIVE"&(RECINACT=0)
; Check for Termination Date in #200 - VSE-1267
S SDTERM=$$ACTIVE^XUSER(PROVIEN)
Q:(RECINACT=0)&($P(SDTERM,U,1)'=1)
S SDCNT=SDCNT+1
;S ^TMP("RECDATA",$J,PROVNAME)=SDI_U_PROVIEN_U_PROVNAME_U_TEAMID_U_TEAMNAME_U_DIVIEN_U_DIVNAME_U_PTELE_U_EXT_U_RRPSTATUS_U_KEYIEN_U_KEYNAME
S ^TMP("RECDATA",$J,SDCNT)=SDI_U_PROVIEN_U_PROVNAME_" - "_TEAMNAME_U_TEAMID_U_TEAMNAME_U_DIVIEN_U_DIVNAME_U_PTELE_U_EXT_U_RRPSTATUS_U_KEYIEN_U_KEYNAME
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC52B 5955 printed Dec 13, 2024@02:50:46 Page 2
SDEC52B ;ALB/MGD/ANU,TJB - VISTA SCHEDULING RPCS ;oct 20, 2022
+1 ;;5.3;Scheduling;**627,796,797,827,877**;Aug 13, 1993;Build 14
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Reference to ^VA(200 in ICR #10060
+5 ;
+6 QUIT
+7 ;
RECAPGET(SDECY) ; GET entries from the RECALL REMINDERS APPT TYPE file 403.51
+1 ;RECAPGET(SDECY) external parameter tag is in SDEC
+2 ;INPUT: none
+3 ;RETURN:
+4 ; Successful Return:
+5 ; Global Array in which each array entry contains Recall Reminders Appt
+6 ; type names from the RECALL REMINDERS APPT TYPE file 403.51
+7 ; Data is separated by ^:
+8 ; 1. RECALL REMINDERS APPT TYPE ien
+9 ; 2. RECALL REMINDERS APPT TYPE name
+10 ; Caught Exception Return:
+11 ; A single entry in the Global Array in the format "-1^<error text>"
+12 ; "T00020RETURNCODE^T00100TEXT"
+13 ; Unexpected Exception Return:
+14 ; Handled by the RPC Broker.
+15 ; M errors are trapped by the use of M and Kernel error handling.
+16 ; The RPC execution stops and the RPC Broker sends the error generated
+17 ; text back to the client.
+18 ;
+19 NEW NAME,SDECI,SDI
+20 SET SDECI=0
+21 KILL ^TMP("SDEC52",$JOB,"RECAPGET")
+22 SET SDECY="^TMP(""SDEC52"","_$JOB_",""RECAPGET"")"
+23 ; data header
+24 SET @SDECY@(SDECI)="T00030RRAPPTYP^T00030RRAPPTYPN"_$CHAR(30)
+25 SET SDI=0
FOR
SET SDI=$ORDER(^SD(403.51,SDI))
if SDI'>0
QUIT
Begin DoDot:1
+26 ; $P($G(^SD(403.51,SDI,0)),U,1)
SET NAME=$$GET1^DIQ(403.51,SDI_",",.01)
+27 SET SDECI=SDECI+1
SET @SDECY@(SDECI)=SDI_U_NAME_$CHAR(30)
End DoDot:1
+28 SET @SDECY@(SDECI)=@SDECY@(SDECI)_$CHAR(31)
+29 QUIT
+30 ;
RECPRGET(SDECY,RECINACT,SDECP,MAXREC,LASTSUB) ; GET entries from the RECALL REMINDERS PROVIDERS file 403.54
+1 ;RECAPGET(SDECY,RECINACT) external parameter tag is in SDEC
+2 ;INPUT:
+3 ; RECINACT - flag to include inactive providers
+4 ; SDECP - (optional) Partial name text
+5 ; MAXREC - (optional) Max records returned
+6 ; LASTSUB - (optional) last subscripts from previous call
+7 ;RETURN:
+8 ; Successful Return:
+9 ; Global Array in which each array entry contains data from RECALL REMINDERS PROVIDERS file 403.54.
+10 ; Data is separated by ^:
+11 ; 1. IEN - Pointer to RECALL REMINDERS PROVIDERS file
+12 ; 2. Provider IEN - Pointer to NEW PERSON file
+13 ; 3. Provider Name - NAME from NEW PERSON file
+14 ; 4. Team ID - Pointer to RECALL REMINDERS TEAM file 403.55
+15 ; 5. Team Name - NAME from RECALL REMINDERS TEAM file 403.55
+16 ; 6. Division ID - Pointer to MEDICAL CENTER DIVISION file 40.8
+17 ; 7. Division Name - NAME from MEDICAL CENTER DIVISION file 40.8
+18 ; 8. Direct Phone - Free-Text 7-14 Characters
+19 ; 9. EXT. - Free-Text 4-20 characters
+20 ; 10. Status - Valid values are:
+21 ; ACTIVE
+22 ; INACTIVE
+23 ; 11. Security Key ID - Pointer to SECURITY KEY file 19.1
+24 ; 12. Security Key Name - NAME from SECURITY KEY file 19.1
+25 ; 13. LASTSUB - Subscripts from last call
+26 ; Caught Exception Return:
+27 ; A single entry in the Global Array in the format "-1^<error text>"
+28 ; "T00020RETURNCODE^T00100TEXT"
+29 ; Unexpected Exception Return:
+30 ; Handled by the RPC Broker.
+31 ; M errors are trapped by the use of M and Kernel error handling.
+32 ; The RPC execution stops and the RPC Broker sends the error generated
+33 ; text back to the client.
+34 ;
+35 NEW LSUB,PRVDATA,SDCNT,SDECI,SDI,SDJ,SDK,SDTMP
+36 SET (SDI,SDJ,SDK)=""
+37 SET (SDCNT,SDECI)=0
+38 KILL ^TMP("RECDATA",$JOB)
+39 SET RECINACT=$GET(RECINACT)
+40 IF RECINACT=""
SET RECINACT=0
+41 KILL ^TMP("SDEC52",$JOB,"RECPRGET")
+42 SET SDECY="^TMP(""SDEC52"","_$JOB_",""RECPRGET"")"
+43 ; data header
+44 SET SDTMP="T00030RRPROVIEN^T00030PROVIEN^T00030PROVNAME^T00030TEAMID^T00030TEAMNAME^T00030DIVIEN"
+45 SET SDTMP=SDTMP_"^T00030DIVNAME^T00030PTELEPHONE^T00020EXT^T00010RRPSTATUS^T00020KEYIEN^T00030KEYNAME"
+46 SET SDTMP=SDTMP_"^T00030LASTSUB"
+47 SET @SDECY@(SDECI)=SDTMP_$CHAR(30)
+48 SET SDECP=$GET(SDECP)
+49 SET MAXREC=$GET(MAXREC,200)
if MAXREC=""
SET MAXREC=200
+50 SET LASTSUB=$GET(LASTSUB)
+51 IF SDECP'=""
Begin DoDot:1
+52 SET SDK=$SELECT($PIECE(LASTSUB,"|",1)'="":$$GETSUB^SDECU($PIECE(LASTSUB,"|",1)),1:$$GETSUB^SDECU(SDECP))
+53 FOR
SET SDK=$ORDER(^VA(200,"B",SDK))
if SDK=""
QUIT
if SDK'[SDECP
QUIT
Begin DoDot:2
+54 SET SDJ=$SELECT($PIECE(LASTSUB,"|",2)'="":$PIECE(LASTSUB,"|",2)-1,1:0)
+55 FOR
SET SDJ=$ORDER(^VA(200,"B",SDK,SDJ))
if SDJ'>0
QUIT
Begin DoDot:3
+56 SET SDI=$SELECT($PIECE(LASTSUB,"|",3)'="":$PIECE(LASTSUB,"|",3),1:0)
+57 FOR
SET SDI=$ORDER(^SD(403.54,"B",SDJ,SDI))
if SDI'>0
QUIT
DO GET1PR(SDI,RECINACT,.SDCNT)
if SDCNT'<MAXREC
QUIT
End DoDot:3
if SDCNT'<MAXREC
QUIT
End DoDot:2
if SDCNT'<MAXREC
QUIT
End DoDot:1
+58 IF '$TEST
SET SDI=0
FOR
SET SDI=$ORDER(^SD(403.54,SDI))
if SDI'>0
QUIT
DO GET1PR(SDI,RECINACT,.SDCNT)
+59 NEW PRVNAME
+60 SET PRVNAME=""
+61 FOR
SET PRVNAME=$ORDER(^TMP("RECDATA",$JOB,PRVNAME))
if PRVNAME=""
QUIT
Begin DoDot:1
+62 SET PRVDATA=$GET(^TMP("RECDATA",$JOB,PRVNAME))
+63 SET SDECI=SDECI+1
+64 SET @SDECY@(SDECI)=PRVDATA_$CHAR(30)
+65 SET @SDECY@(SDECI)=@SDECY@(SDECI)_$CHAR(31)
End DoDot:1
+66 IF SDCNT'<MAXREC
IF SDECP'=""
IF SDK[SDECP
Begin DoDot:1
+67 SET SDTMP=$PIECE(@SDECY@(SDECI),$CHAR(30,31),1)
+68 SET $PIECE(SDTMP,U,13)=SDK_"|"_SDJ_"|"_SDI
+69 SET @SDECY@(SDECI)=SDTMP_$CHAR(30,31)
End DoDot:1
+70 KILL ^TMP("RECDATA",$JOB)
+71 QUIT
GET1PR(SDI,RECINACT,SDCNT) ;
+1 NEW SDDATA,SDMSG,SDTERM
+2 NEW RRPSTATUS,DIVIEN,DIVNAME,EXT,KEYIEN,KEYNAME,PROVIEN,PROVNAME,TEAMID,TEAMNAME,PTELE
+3 DO GETS^DIQ(403.54,SDI,"**","IE","SDDATA","SDMSG")
+4 SET PROVIEN=SDDATA(403.54,SDI_",",.01,"I")
+5 SET PROVNAME=SDDATA(403.54,SDI_",",.01,"E")
+6 SET TEAMID=SDDATA(403.54,SDI_",",1,"I")
+7 SET TEAMNAME=SDDATA(403.54,SDI_",",1,"E")
+8 SET DIVIEN=SDDATA(403.54,SDI_",",2,"I")
+9 SET DIVNAME=SDDATA(403.54,SDI_",",2,"E")
+10 SET PTELE=SDDATA(403.54,SDI_",",3,"I")
+11 SET EXT=SDDATA(403.54,SDI_",",4,"I")
+12 SET RRPSTATUS=SDDATA(403.54,SDI_",",5,"E")
+13 SET KEYIEN=SDDATA(403.54,SDI_",",6,"I")
+14 SET KEYNAME=SDDATA(403.54,SDI_",",6,"E")
+15 if RRPSTATUS="INACTIVE"&(RECINACT=0)
QUIT
+16 ; Check for Termination Date in #200 - VSE-1267
+17 SET SDTERM=$$ACTIVE^XUSER(PROVIEN)
+18 if (RECINACT=0)&($PIECE(SDTERM,U,1)'=1)
QUIT
+19 SET SDCNT=SDCNT+1
+20 ;S ^TMP("RECDATA",$J,PROVNAME)=SDI_U_PROVIEN_U_PROVNAME_U_TEAMID_U_TEAMNAME_U_DIVIEN_U_DIVNAME_U_PTELE_U_EXT_U_RRPSTATUS_U_KEYIEN_U_KEYNAME
+21 SET ^TMP("RECDATA",$JOB,SDCNT)=SDI_U_PROVIEN_U_PROVNAME_" - "_TEAMNAME_U_TEAMID_U_TEAMNAME_U_DIVIEN_U_DIVNAME_U_PTELE_U_EXT_U_RRPSTATUS_U_KEYIEN_U_KEYNAME
+22 QUIT
