- 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 Feb 19, 2025@00:24:13 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