Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDEC52B

SDEC52B.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 6402, this routine should not be modified
  1. ;
  1. ; Reference to ^VA(200 in ICR #10060
  1. ;
  1. Q
  1. ;
  1. RECAPGET(SDECY) ; GET entries from the RECALL REMINDERS APPT TYPE file 403.51
  1. ;RECAPGET(SDECY) external parameter tag is in SDEC
  1. ;INPUT: none
  1. ;RETURN:
  1. ; Successful Return:
  1. ; Global Array in which each array entry contains Recall Reminders Appt
  1. ; type names from the RECALL REMINDERS APPT TYPE file 403.51
  1. ; Data is separated by ^:
  1. ; 1. RECALL REMINDERS APPT TYPE ien
  1. ; 2. RECALL REMINDERS APPT TYPE name
  1. ; Caught Exception Return:
  1. ; A single entry in the Global Array in the format "-1^<error text>"
  1. ; "T00020RETURNCODE^T00100TEXT"
  1. ; Unexpected Exception Return:
  1. ; Handled by the RPC Broker.
  1. ; M errors are trapped by the use of M and Kernel error handling.
  1. ; The RPC execution stops and the RPC Broker sends the error generated
  1. ; text back to the client.
  1. ;
  1. N NAME,SDECI,SDI
  1. S SDECI=0
  1. K ^TMP("SDEC52",$J,"RECAPGET")
  1. S SDECY="^TMP(""SDEC52"","_$J_",""RECAPGET"")"
  1. ; data header
  1. S @SDECY@(SDECI)="T00030RRAPPTYP^T00030RRAPPTYPN"_$C(30)
  1. S SDI=0 F S SDI=$O(^SD(403.51,SDI)) Q:SDI'>0 D
  1. .S NAME=$$GET1^DIQ(403.51,SDI_",",.01) ; $P($G(^SD(403.51,SDI,0)),U,1)
  1. .S SDECI=SDECI+1 S @SDECY@(SDECI)=SDI_U_NAME_$C(30)
  1. S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
  1. Q
  1. ;
  1. 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
  1. ;INPUT:
  1. ; RECINACT - flag to include inactive providers
  1. ; SDECP - (optional) Partial name text
  1. ; MAXREC - (optional) Max records returned
  1. ; LASTSUB - (optional) last subscripts from previous call
  1. ;RETURN:
  1. ; Successful Return:
  1. ; Global Array in which each array entry contains data from RECALL REMINDERS PROVIDERS file 403.54.
  1. ; Data is separated by ^:
  1. ; 1. IEN - Pointer to RECALL REMINDERS PROVIDERS file
  1. ; 2. Provider IEN - Pointer to NEW PERSON file
  1. ; 3. Provider Name - NAME from NEW PERSON file
  1. ; 4. Team ID - Pointer to RECALL REMINDERS TEAM file 403.55
  1. ; 5. Team Name - NAME from RECALL REMINDERS TEAM file 403.55
  1. ; 6. Division ID - Pointer to MEDICAL CENTER DIVISION file 40.8
  1. ; 7. Division Name - NAME from MEDICAL CENTER DIVISION file 40.8
  1. ; 8. Direct Phone - Free-Text 7-14 Characters
  1. ; 9. EXT. - Free-Text 4-20 characters
  1. ; 10. Status - Valid values are:
  1. ; ACTIVE
  1. ; INACTIVE
  1. ; 11. Security Key ID - Pointer to SECURITY KEY file 19.1
  1. ; 12. Security Key Name - NAME from SECURITY KEY file 19.1
  1. ; 13. LASTSUB - Subscripts from last call
  1. ; Caught Exception Return:
  1. ; A single entry in the Global Array in the format "-1^<error text>"
  1. ; "T00020RETURNCODE^T00100TEXT"
  1. ; Unexpected Exception Return:
  1. ; Handled by the RPC Broker.
  1. ; M errors are trapped by the use of M and Kernel error handling.
  1. ; The RPC execution stops and the RPC Broker sends the error generated
  1. ; text back to the client.
  1. ;
  1. N LSUB,PRVDATA,SDCNT,SDECI,SDI,SDJ,SDK,SDTMP
  1. S (SDI,SDJ,SDK)=""
  1. S (SDCNT,SDECI)=0
  1. K ^TMP("RECDATA",$J)
  1. S RECINACT=$G(RECINACT)
  1. I RECINACT="" S RECINACT=0
  1. K ^TMP("SDEC52",$J,"RECPRGET")
  1. S SDECY="^TMP(""SDEC52"","_$J_",""RECPRGET"")"
  1. ; data header
  1. S SDTMP="T00030RRPROVIEN^T00030PROVIEN^T00030PROVNAME^T00030TEAMID^T00030TEAMNAME^T00030DIVIEN"
  1. S SDTMP=SDTMP_"^T00030DIVNAME^T00030PTELEPHONE^T00020EXT^T00010RRPSTATUS^T00020KEYIEN^T00030KEYNAME"
  1. S SDTMP=SDTMP_"^T00030LASTSUB"
  1. S @SDECY@(SDECI)=SDTMP_$C(30)
  1. S SDECP=$G(SDECP)
  1. S MAXREC=$G(MAXREC,200) S:MAXREC="" MAXREC=200
  1. S LASTSUB=$G(LASTSUB)
  1. I SDECP'="" D
  1. .S SDK=$S($P(LASTSUB,"|",1)'="":$$GETSUB^SDECU($P(LASTSUB,"|",1)),1:$$GETSUB^SDECU(SDECP))
  1. .F S SDK=$O(^VA(200,"B",SDK)) Q:SDK="" Q:SDK'[SDECP D Q:SDCNT'<MAXREC
  1. ..S SDJ=$S($P(LASTSUB,"|",2)'="":$P(LASTSUB,"|",2)-1,1:0)
  1. ..F S SDJ=$O(^VA(200,"B",SDK,SDJ)) Q:SDJ'>0 D Q:SDCNT'<MAXREC
  1. ...S SDI=$S($P(LASTSUB,"|",3)'="":$P(LASTSUB,"|",3),1:0)
  1. ...F S SDI=$O(^SD(403.54,"B",SDJ,SDI)) Q:SDI'>0 D GET1PR(SDI,RECINACT,.SDCNT) Q:SDCNT'<MAXREC
  1. E S SDI=0 F S SDI=$O(^SD(403.54,SDI)) Q:SDI'>0 D GET1PR(SDI,RECINACT,.SDCNT)
  1. N PRVNAME
  1. S PRVNAME=""
  1. F S PRVNAME=$O(^TMP("RECDATA",$J,PRVNAME)) Q:PRVNAME="" D
  1. .S PRVDATA=$G(^TMP("RECDATA",$J,PRVNAME))
  1. .S SDECI=SDECI+1
  1. .S @SDECY@(SDECI)=PRVDATA_$C(30)
  1. .S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
  1. I SDCNT'<MAXREC,SDECP'="",SDK[SDECP D
  1. .S SDTMP=$P(@SDECY@(SDECI),$C(30,31),1)
  1. .S $P(SDTMP,U,13)=SDK_"|"_SDJ_"|"_SDI
  1. .S @SDECY@(SDECI)=SDTMP_$C(30,31)
  1. K ^TMP("RECDATA",$J)
  1. Q
  1. GET1PR(SDI,RECINACT,SDCNT) ;
  1. N SDDATA,SDMSG,SDTERM
  1. N RRPSTATUS,DIVIEN,DIVNAME,EXT,KEYIEN,KEYNAME,PROVIEN,PROVNAME,TEAMID,TEAMNAME,PTELE
  1. D GETS^DIQ(403.54,SDI,"**","IE","SDDATA","SDMSG")
  1. S PROVIEN=SDDATA(403.54,SDI_",",.01,"I")
  1. S PROVNAME=SDDATA(403.54,SDI_",",.01,"E")
  1. S TEAMID=SDDATA(403.54,SDI_",",1,"I")
  1. S TEAMNAME=SDDATA(403.54,SDI_",",1,"E")
  1. S DIVIEN=SDDATA(403.54,SDI_",",2,"I")
  1. S DIVNAME=SDDATA(403.54,SDI_",",2,"E")
  1. S PTELE=SDDATA(403.54,SDI_",",3,"I")
  1. S EXT=SDDATA(403.54,SDI_",",4,"I")
  1. S RRPSTATUS=SDDATA(403.54,SDI_",",5,"E")
  1. S KEYIEN=SDDATA(403.54,SDI_",",6,"I")
  1. S KEYNAME=SDDATA(403.54,SDI_",",6,"E")
  1. Q:RRPSTATUS="INACTIVE"&(RECINACT=0)
  1. ; Check for Termination Date in #200 - VSE-1267
  1. S SDTERM=$$ACTIVE^XUSER(PROVIEN)
  1. Q:(RECINACT=0)&($P(SDTERM,U,1)'=1)
  1. S SDCNT=SDCNT+1
  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
  1. 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
  1. Q