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 Nov 22, 2024@18:00:09 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
