SDESRTNRG ;ALB/ANU - VISTA SCHEDULING RPCS - ROUTINE SINGLE CLINIC GROUP RETURN ;Feb 20, 2023@14:21
;;5.3;Scheduling;**826,838**;Aug 13, 1993;Build 7
;;Per VHA Directive 6402, this routine should not be modified
;
;External References
;-------------------
; Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056
; Reference to $$TRIM^XLFSTR in ICR #10104
;
Q
;
;
RTNRG(RETURNJSON,SDRGIEN) ;
;
; Input:
; SDRGIEN [Required] = SDEC RESOURCE GROUP IEN
;
; Output:
; RETURNJSON = Returns SDEC RESOURCE GROUP (#409.832) - Group IEN^Inactivation Date^Group Name^Resources.
;
N RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN
N ISRGNAMEVALID
S (RETURN,ELGFIELDSARRAY,HASFIELDS)=""
;
S ISRGNAMEVALID=$$VALIDATERGIEN(.ERRORS,$G(SDRGIEN))
;
I $D(ERRORS) M RETURN=ERRORS
I '$D(ERRORS) S HASFIELDS=$$BLDRG(.ELGFIELDSARRAY,SDRGIEN)
I HASFIELDS M RETURN=ELGFIELDSARRAY
;
D BUILDJSON^SDESBUILDJSON(.RETURNJSON,.RETURN)
D CLEANUP
Q
;
VALIDATERGIEN(ERRORS,SDRGIEN) ; Validate Resource Group IEN
N ERRORFLAG
I SDRGIEN="" S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,312) Q $D(ERRORFLAG) ; Missing Resource Group IEN
I SDRGIEN'="" I '$D(^SDEC(409.832,SDRGIEN,0)) S ERRORFLAG=1 D ERRLOG^SDESJSON(.ERRORS,276) Q $D(ERRORFLAG) ; Invalid Resource Group ID
Q $D(ERRORFLAG)
;
BLDRG(SDRGREC,SDRGIEN) ;Get SDEC Resource Group data
;
N SDFIELDS,SDDATA,SDMSG,SDX,SDC,TIMEZONE,SDECI,HASDATA,SDESRES,SDRSTYPE,SDTYPR,SDRSPR,SDPRCLINS
N CLINICIEN,COUNT
S SDC=$G(SDC,0),SDX=""
S SDFIELDS=".01;.02"
D GETS^DIQ(409.832,SDRGIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
;S SDECI=SDECI+1
S SDRGREC("RSGroup","IEN")=$G(SDRGIEN) ;Resource Group IEN
S SDRGREC("RSGroup","Name")=$G(SDDATA(409.832,SDRGIEN_",",.01,"E")) ;Clinic Group Name
S SDRGREC("RSGroup","Inactivation Date")=$$FMTISO^SDAMUTDT($G(SDDATA(409.832,SDRGIEN_",",.02,"I"))) ;Inactivate Date
S SDFIELDS="1*"
D GETS^DIQ(409.832,SDRGIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
F S SDX=$O(SDDATA(409.8321,SDX)) Q:$G(SDX)="" D
. S SDC=SDC+1
. S SDESRES=$G(SDDATA(409.8321,SDX,.01,"I"))
. I SDESRES="" Q
. ; Do not include inactive entries
. I $$GET1^DIQ(409.831,SDESRES_",",.02)="YES" Q
. S SDTYPR=$$GET1^DIQ(409.831,SDESRES_",",.012,"I")
. S SDRSTYPE=$S($P(SDTYPR,";",2)="SC(":"CLINIC",$P(SDTYPR,";",2)="VA(200,":"PROVIDER",$P(SDTYPR,";",2)="SDEC(409.834,":"ADDITIONAL RESOURCE",1:"")
. S SDRGREC("RSGroup","Resources",SDC,"IEN")=$P(SDTYPR,";",1)
. S SDRGREC("RSGroup","Resources",SDC,"Name")=$G(SDDATA(409.8321,SDX,.01,"E"))
. S SDRGREC("RSGroup","Resources",SDC,"Type")=SDRSTYPE
. I SDRSTYPE="PROVIDER" D
. . S SDRSPR=$P(SDTYPR,";",1)
. . S CLINICIEN=0,COUNT=0
. . F S CLINICIEN=$O(^SC("AVADPR",SDRSPR,CLINICIEN)) Q:'CLINICIEN D
. . . S COUNT=COUNT+1
. . . S SDRGREC("RSGroup","Resources",SDC,"Provider",COUNT,"AssociatedClinicIEN")=CLINICIEN
. . . S SDRGREC("RSGroup","Resources",SDC,"Provider",COUNT,"AssociatedClinicName")=$$GET1^DIQ(44,CLINICIEN,.01,"E")
S HASDATA=($D(SDRGREC)>1)
Q HASDATA
;
Q
;
CLEANUP ; kill vars
K RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN,SDECI,ERRORS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDESRTNRG 3141 printed Apr 09, 2024@22:05:21 Page 2
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
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ;External References
+5 ;-------------------
+6 ; Reference to $$GETS^DIQ,$$GETS1^DIQ in ICR #2056
+7 ; Reference to $$TRIM^XLFSTR in ICR #10104
+8 ;
+9 QUIT
+10 ;
+11 ;
RTNRG(RETURNJSON,SDRGIEN) ;
+1 ;
+2 ; Input:
+3 ; SDRGIEN [Required] = SDEC RESOURCE GROUP IEN
+4 ;
+5 ; Output:
+6 ; RETURNJSON = Returns SDEC RESOURCE GROUP (#409.832) - Group IEN^Inactivation Date^Group Name^Resources.
+7 ;
+8 NEW RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN
+9 NEW ISRGNAMEVALID
+10 SET (RETURN,ELGFIELDSARRAY,HASFIELDS)=""
+11 ;
+12 SET ISRGNAMEVALID=$$VALIDATERGIEN(.ERRORS,$GET(SDRGIEN))
+13 ;
+14 IF $DATA(ERRORS)
MERGE RETURN=ERRORS
+15 IF '$DATA(ERRORS)
SET HASFIELDS=$$BLDRG(.ELGFIELDSARRAY,SDRGIEN)
+16 IF HASFIELDS
MERGE RETURN=ELGFIELDSARRAY
+17 ;
+18 DO BUILDJSON^SDESBUILDJSON(.RETURNJSON,.RETURN)
+19 DO CLEANUP
+20 QUIT
+21 ;
VALIDATERGIEN(ERRORS,SDRGIEN) ; Validate Resource Group IEN
+1 NEW ERRORFLAG
+2 ; Missing Resource Group IEN
IF SDRGIEN=""
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,312)
QUIT $DATA(ERRORFLAG)
+3 ; Invalid Resource Group ID
IF SDRGIEN'=""
IF '$DATA(^SDEC(409.832,SDRGIEN,0))
SET ERRORFLAG=1
DO ERRLOG^SDESJSON(.ERRORS,276)
QUIT $DATA(ERRORFLAG)
+4 QUIT $DATA(ERRORFLAG)
+5 ;
BLDRG(SDRGREC,SDRGIEN) ;Get SDEC Resource Group data
+1 ;
+2 NEW SDFIELDS,SDDATA,SDMSG,SDX,SDC,TIMEZONE,SDECI,HASDATA,SDESRES,SDRSTYPE,SDTYPR,SDRSPR,SDPRCLINS
+3 NEW CLINICIEN,COUNT
+4 SET SDC=$GET(SDC,0)
SET SDX=""
+5 SET SDFIELDS=".01;.02"
+6 DO GETS^DIQ(409.832,SDRGIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
+7 ;S SDECI=SDECI+1
+8 ;Resource Group IEN
SET SDRGREC("RSGroup","IEN")=$GET(SDRGIEN)
+9 ;Clinic Group Name
SET SDRGREC("RSGroup","Name")=$GET(SDDATA(409.832,SDRGIEN_",",.01,"E"))
+10 ;Inactivate Date
SET SDRGREC("RSGroup","Inactivation Date")=$$FMTISO^SDAMUTDT($GET(SDDATA(409.832,SDRGIEN_",",.02,"I")))
+11 SET SDFIELDS="1*"
+12 DO GETS^DIQ(409.832,SDRGIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
+13 FOR
SET SDX=$ORDER(SDDATA(409.8321,SDX))
if $GET(SDX)=""
QUIT
Begin DoDot:1
+14 SET SDC=SDC+1
+15 SET SDESRES=$GET(SDDATA(409.8321,SDX,.01,"I"))
+16 IF SDESRES=""
QUIT
+17 ; Do not include inactive entries
+18 IF $$GET1^DIQ(409.831,SDESRES_",",.02)="YES"
QUIT
+19 SET SDTYPR=$$GET1^DIQ(409.831,SDESRES_",",.012,"I")
+20 SET SDRSTYPE=$SELECT($PIECE(SDTYPR,";",2)="SC(":"CLINIC",$PIECE(SDTYPR,";",2)="VA(200,":"PROVIDER",$PIECE(SDTYPR,";",2)="SDEC(409.834,":"ADDITIONAL RESOURCE",1:"")
+21 SET SDRGREC("RSGroup","Resources",SDC,"IEN")=$PIECE(SDTYPR,";",1)
+22 SET SDRGREC("RSGroup","Resources",SDC,"Name")=$GET(SDDATA(409.8321,SDX,.01,"E"))
+23 SET SDRGREC("RSGroup","Resources",SDC,"Type")=SDRSTYPE
+24 IF SDRSTYPE="PROVIDER"
Begin DoDot:2
+25 SET SDRSPR=$PIECE(SDTYPR,";",1)
+26 SET CLINICIEN=0
SET COUNT=0
+27 FOR
SET CLINICIEN=$ORDER(^SC("AVADPR",SDRSPR,CLINICIEN))
if 'CLINICIEN
QUIT
Begin DoDot:3
+28 SET COUNT=COUNT+1
+29 SET SDRGREC("RSGroup","Resources",SDC,"Provider",COUNT,"AssociatedClinicIEN")=CLINICIEN
+30 SET SDRGREC("RSGroup","Resources",SDC,"Provider",COUNT,"AssociatedClinicName")=$$GET1^DIQ(44,CLINICIEN,.01,"E")
End DoDot:3
End DoDot:2
End DoDot:1
+31 SET HASDATA=($DATA(SDRGREC)>1)
+32 QUIT HASDATA
+33 ;
+34 QUIT
+35 ;
CLEANUP ; kill vars
+1 KILL RETURN,HASFIELDS,ELGFIELDSARRAY,ELGRETURN,SDECI,ERRORS
+2 QUIT
