- SDEC15 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
- ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
- ;
- Q
- ;
- ;
- ACCGPTYG(SDECY) ;Get access group types
- ;ACCGPTYG(SDECY) external parameter tag is in SDEC
- ;Returns ADO recordset containing ACTIVE Access types ordered alphabetically
- ;by Access Group
- ;AccessGroupID, AccessGroup, AccessTypeID, AccessType
- ;
- N SDEC0,SDEC1,SDEC2,SDECGPN,SDECI,SDECNOD,SDECTN
- S SDECY="^TMP(""SDEC"","_$J_")"
- K @SDECY
- S SDECI=0
- S ^TMP("SDEC",$J,SDECI)="I00020ACCESS_GROUP_TYPEID^I00020ACCESS_GROUP_ID^T00030ACCESS_GROUP^I00020ACCESS_TYPE_ID^T00030ACCESS_TYPE"_$C(30)
- ;
- ;$O Through "B" x-ref of SDEC ACCESS GROUP file
- S SDECGPN=0 F S SDECGPN=$O(^SDEC(409.822,"B",SDECGPN)) Q:SDECGPN="" D
- . S SDEC0=$O(^SDEC(409.822,"B",SDECGPN,0))
- . Q:'+SDEC0
- . Q:'$D(^SDEC(409.822,SDEC0,0)) ;INDEX VALIDITY CHECK
- . Q:'$D(^SDEC(409.824,"B",SDEC0))
- . ;$O through "B" x-ref of SDEC ACCESS GROUP TYPE
- . S SDEC1=0 F S SDEC1=$O(^SDEC(409.824,"B",SDEC0,SDEC1)) Q:'+SDEC1 D
- . . Q:'$D(^SDEC(409.824,SDEC1,0))
- . . S SDEC2=$P(^SDEC(409.824,SDEC1,0),U,2)
- . . Q:'+SDEC2
- . . Q:'$D(^SDEC(409.823,SDEC2,0))
- . . S SDECNOD=^SDEC(409.823,SDEC2,0)
- . . Q:$P(SDECNOD,U,2)=1 ;INACTIVE
- . . S SDECTN=$P(SDECNOD,U)
- . . S SDECI=SDECI+1
- . . S ^TMP("SDEC",$J,SDECI)=SDEC1_U_SDEC0_U_SDECGPN_U_SDEC2_U_SDECTN_$C(30)
- . . Q
- . Q
- S ^TMP("SDEC",$J,SDECI)=^TMP("SDEC",$J,SDECI)_$C(31)
- Q
- ;
- ERR(SDECI,SDECID,SDECERR) ;Error processing
- S SDECI=SDECI+1
- S ^TMP("SDEC",$J,SDECI)=SDECERR_"^^^^"_$C(30)
- S SDECI=SDECI+1
- S ^TMP("SDEC",$J,SDECI)=$C(31)
- Q
- ;
- ETRAP ;EP Error trap entry
- I '$D(SDECI) N SDECI S SDECI=999
- S SDECI=SDECI+1
- D ERR(SDECI,99,70)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC15 1719 printed Feb 19, 2025@00:16:35 Page 2
- SDEC15 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
- +1 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
- +2 ;
- +3 QUIT
- +4 ;
- +5 ;
- ACCGPTYG(SDECY) ;Get access group types
- +1 ;ACCGPTYG(SDECY) external parameter tag is in SDEC
- +2 ;Returns ADO recordset containing ACTIVE Access types ordered alphabetically
- +3 ;by Access Group
- +4 ;AccessGroupID, AccessGroup, AccessTypeID, AccessType
- +5 ;
- +6 NEW SDEC0,SDEC1,SDEC2,SDECGPN,SDECI,SDECNOD,SDECTN
- +7 SET SDECY="^TMP(""SDEC"","_$JOB_")"
- +8 KILL @SDECY
- +9 SET SDECI=0
- +10 SET ^TMP("SDEC",$JOB,SDECI)="I00020ACCESS_GROUP_TYPEID^I00020ACCESS_GROUP_ID^T00030ACCESS_GROUP^I00020ACCESS_TYPE_ID^T00030ACCESS_TYPE"_$CHAR(30)
- +11 ;
- +12 ;$O Through "B" x-ref of SDEC ACCESS GROUP file
- +13 SET SDECGPN=0
- FOR
- SET SDECGPN=$ORDER(^SDEC(409.822,"B",SDECGPN))
- if SDECGPN=""
- QUIT
- Begin DoDot:1
- +14 SET SDEC0=$ORDER(^SDEC(409.822,"B",SDECGPN,0))
- +15 if '+SDEC0
- QUIT
- +16 ;INDEX VALIDITY CHECK
- if '$DATA(^SDEC(409.822,SDEC0,0))
- QUIT
- +17 if '$DATA(^SDEC(409.824,"B",SDEC0))
- QUIT
- +18 ;$O through "B" x-ref of SDEC ACCESS GROUP TYPE
- +19 SET SDEC1=0
- FOR
- SET SDEC1=$ORDER(^SDEC(409.824,"B",SDEC0,SDEC1))
- if '+SDEC1
- QUIT
- Begin DoDot:2
- +20 if '$DATA(^SDEC(409.824,SDEC1,0))
- QUIT
- +21 SET SDEC2=$PIECE(^SDEC(409.824,SDEC1,0),U,2)
- +22 if '+SDEC2
- QUIT
- +23 if '$DATA(^SDEC(409.823,SDEC2,0))
- QUIT
- +24 SET SDECNOD=^SDEC(409.823,SDEC2,0)
- +25 ;INACTIVE
- if $PIECE(SDECNOD,U,2)=1
- QUIT
- +26 SET SDECTN=$PIECE(SDECNOD,U)
- +27 SET SDECI=SDECI+1
- +28 SET ^TMP("SDEC",$JOB,SDECI)=SDEC1_U_SDEC0_U_SDECGPN_U_SDEC2_U_SDECTN_$CHAR(30)
- +29 QUIT
- End DoDot:2
- +30 QUIT
- End DoDot:1
- +31 SET ^TMP("SDEC",$JOB,SDECI)=^TMP("SDEC",$JOB,SDECI)_$CHAR(31)
- +32 QUIT
- +33 ;
- ERR(SDECI,SDECID,SDECERR) ;Error processing
- +1 SET SDECI=SDECI+1
- +2 SET ^TMP("SDEC",$JOB,SDECI)=SDECERR_"^^^^"_$CHAR(30)
- +3 SET SDECI=SDECI+1
- +4 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
- +5 QUIT
- +6 ;
- ETRAP ;EP Error trap entry
- +1 IF '$DATA(SDECI)
- NEW SDECI
- SET SDECI=999
- +2 SET SDECI=SDECI+1
- +3 DO ERR(SDECI,99,70)
- +4 QUIT