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

SDESRTNRG.m

Go to the documentation of this file.
  1. SDESRTNRG ;ALB/ANU - VISTA SCHEDULING RPCS - ROUTINE SINGLE CLINIC GROUP RETURN ;Feb 20, 2023@14:21
  1. ;;5.3;Scheduling;**826,838**;Aug 13, 1993;Build 7
  1. ;;Per VHA Directive 6402, this routine should not be modified
  1. ;
  1. ;External References
  1. ;-------------------
  1. ; Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056
  1. ; Reference to $$TRIM^XLFSTR in ICR #10104
  1. ;
  1. Q
  1. ;
  1. ;
  1. RTNRG(RETURNJSON,SDRGIEN) ;
  1. ;
  1. ; Input:
  1. ; SDRGIEN [Required] = SDEC RESOURCE GROUP IEN
  1. ;
  1. ; Output:
  1. ; RETURNJSON = Returns SDEC RESOURCE GROUP (#409.832) - Group IEN^Inactivation Date^Group Name^Resources.
  1. ;
  1. N RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN
  1. N ISRGNAMEVALID
  1. S (RETURN,ELGFIELDSARRAY,HASFIELDS)=""
  1. ;
  1. S ISRGNAMEVALID=$$VALIDATERGIEN(.ERRORS,$G(SDRGIEN))
  1. ;
  1. I $D(ERRORS) M RETURN=ERRORS
  1. I '$D(ERRORS) S HASFIELDS=$$BLDRG(.ELGFIELDSARRAY,SDRGIEN)
  1. I HASFIELDS M RETURN=ELGFIELDSARRAY
  1. ;
  1. D BUILDJSON^SDESBUILDJSON(.RETURNJSON,.RETURN)
  1. D CLEANUP
  1. Q
  1. ;
  1. VALIDATERGIEN(ERRORS,SDRGIEN) ; Validate Resource Group IEN
  1. N ERRORFLAG
  1. I SDRGIEN="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,312) Q $D(ERRORFLAG) ; Missing Resource Group IEN
  1. I SDRGIEN'="" I '$D(^SDEC(409.832,SDRGIEN,0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,276) Q $D(ERRORFLAG) ; Invalid Resource Group ID
  1. Q $D(ERRORFLAG)
  1. ;
  1. BLDRG(SDRGREC,SDRGIEN) ;Get SDEC Resource Group data
  1. ;
  1. N SDFIELDS,SDDATA,SDMSG,SDX,SDC,TIMEZONE,SDECI,HASDATA,SDESRES,SDRSTYPE,SDTYPR,SDRSPR,SDPRCLINS
  1. N CLINICIEN,COUNT
  1. S SDC=$G(SDC,0),SDX=""
  1. S SDFIELDS=".01;.02"
  1. D GETS^DIQ(409.832,SDRGIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
  1. ;S SDECI=SDECI+1
  1. S SDRGREC("RSGroup","IEN")=$G(SDRGIEN) ;Resource Group IEN
  1. S SDRGREC("RSGroup","Name")=$G(SDDATA(409.832,SDRGIEN_",",.01,"E")) ;Clinic Group Name
  1. S SDRGREC("RSGroup","Inactivation Date")=$$FMTISO^SDAMUTDT($G(SDDATA(409.832,SDRGIEN_",",.02,"I"))) ;Inactivate Date
  1. S SDFIELDS="1*"
  1. D GETS^DIQ(409.832,SDRGIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
  1. F S SDX=$O(SDDATA(409.8321,SDX)) Q:$G(SDX)="" D
  1. . S SDC=SDC+1
  1. . S SDESRES=$G(SDDATA(409.8321,SDX,.01,"I"))
  1. . I SDESRES="" Q
  1. . ; Do not include inactive entries
  1. . I $$GET1^DIQ(409.831,SDESRES_",",.02)="YES" Q
  1. . S SDTYPR=$$GET1^DIQ(409.831,SDESRES_",",.012,"I")
  1. . S SDRSTYPE=$S($P(SDTYPR,";",2)="SC(":"CLINIC",$P(SDTYPR,";",2)="VA(200,":"PROVIDER",$P(SDTYPR,";",2)="SDEC(409.834,":"ADDITIONAL RESOURCE",1:"")
  1. . S SDRGREC("RSGroup","Resources",SDC,"IEN")=$P(SDTYPR,";",1)
  1. . S SDRGREC("RSGroup","Resources",SDC,"Name")=$G(SDDATA(409.8321,SDX,.01,"E"))
  1. . S SDRGREC("RSGroup","Resources",SDC,"Type")=SDRSTYPE
  1. . I SDRSTYPE="PROVIDER" D
  1. . . S SDRSPR=$P(SDTYPR,";",1)
  1. . . S CLINICIEN=0,COUNT=0
  1. . . F S CLINICIEN=$O(^SC("AVADPR",SDRSPR,CLINICIEN)) Q:'CLINICIEN D
  1. . . . S COUNT=COUNT+1
  1. . . . S SDRGREC("RSGroup","Resources",SDC,"Provider",COUNT,"AssociatedClinicIEN")=CLINICIEN
  1. . . . S SDRGREC("RSGroup","Resources",SDC,"Provider",COUNT,"AssociatedClinicName")=$$GET1^DIQ(44,CLINICIEN,.01,"E")
  1. S HASDATA=($D(SDRGREC)>1)
  1. Q HASDATA
  1. ;
  1. Q
  1. ;
  1. CLEANUP ; kill vars
  1. K RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN,SDECI,ERRORS
  1. Q