- 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 Jan 18, 2025@03:51:54 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