BSDX15.m

BSDX15 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;

 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010

 ;

 ;

GRPTYP(BSDXY) ;EP

 ;Called by BSDX GET ACCESS GROUP TYPES

 ;Returns ADO recordset containing ACTIVE Access types ordered alphabetically

 ;by Access Group

 ;AccessGroupID, AccessGroup, AccessTypeID, AccessType

 ;

 ;Test Code:

 ;D GRPTYP^BSDX15(.RES) ZW RES

 ;

 S BSDXY="^BSDXTMP("_$J_")"

 N BSDX1

 S BSDXI=0

 S X="ETRAP^BSDX15",@^%ZOSF("TRAP")

 S ^BSDXTMP($J,BSDXI)="I00020ACCESS_GROUP_TYPEID^I00020ACCESS_GROUP_ID^T00030ACCESS_GROUP^I00020ACCESS_TYPE_ID^T00030ACCESS_TYPE"_$C(30)

 ;

 ;N BSDX0,BSDX1,BSDXNOD,BSDXGPN,BSDXTN

 ;$O Through "B" x-ref of BSDX ACCESS GROUP file

 ;S BSDXGPN=0 F  S BSDXGPN=$O(^BSDXAGP("B",BSDXGPN)) Q:BSDXGPN=""  D

 ;. S BSDX0=$O(^BSDXAGP("B",BSDXGPN,0))

 ;. Q:'+BSDX0

 ;. Q:'$D(^BSDXAGP(BSDX0,0))  ;INDEX VALIDITY CHECK

 ;. Q:'$D(^BSDXAGTP("B",BSDX0))

 ;. ;$O through "B" x-ref of BSDX ACCESS GROUP TYPE

 ;. S BSDX1=0 F  S BSDX1=$O(^BSDXAGTP("B",BSDX0,BSDX1)) Q:'+BSDX1  D

 ;. . Q:'$D(^BSDXAGTP(BSDX1,0))

 ;. . S BSDX2=$P(^BSDXAGTP(BSDX1,0),U,2)

 ;. . Q:'+BSDX2

 ;. . Q:'$D(^BSDXTYPE(BSDX2,0))

 ;. . S BSDXNOD=^BSDXTYPE(BSDX2,0)

 ;. . Q:$P(BSDXNOD,U,2)=1  ;INACTIVE

 ;. . S BSDXTN=$P(BSDXNOD,U)

 ;. . S BSDXI=BSDXI+1

 ;. . S ^BSDXTMP($J,BSDXI)=BSDX1_U_BSDX0_U_BSDXGPN_U_BSDX2_U_BSDXTN_$C(30)

 ;. . Q

 ;. Q

 ;

 ;$O Through "AC" x-ref of BSDX ACCESS GROUP TYPE file

 N BSDXAGID,BSDXAGN,BSDXATID,BSDXATN,BSDXAGTID

 S BSDXAGID=0

 F  S BSDXAGID=$O(^BSDXAGTP("AC",BSDXAGID)) Q:'+BSDXAGID  D

 . I '$D(^BSDXAGP(BSDXAGID,0)) Q

 . S BSDXAGN=$P(^BSDXAGP(BSDXAGID,0),U)

 . S BSDXATID=0 F  S BSDXATID=$O(^BSDXAGTP("AC",BSDXAGID,BSDXATID)) Q:'+BSDXATID  D

 . . S BSDXNOD=$G(^BSDXTYPE(BSDXATID,0))

 . . I BSDXNOD="" Q

 . . I $P(BSDXNOD,U,2)=1 Q  ;Inactive

 . . S BSDXATN=$P(BSDXNOD,U)

 . . S BSDXAGTID=$O(^BSDXAGTP("AC",BSDXAGID,BSDXATID,0))

 . . I '+BSDXAGTID Q

 . . I '$D(^BSDXAGTP(BSDXAGTID,0)) Q

 . . S BSDXI=BSDXI+1

 . . S ^BSDXTMP($J,BSDXI)=BSDXAGTID_U_BSDXAGID_U_BSDXAGN_U_BSDXATID_U_BSDXATN_$C(30)

 . . Q

 . Q

 ;

 S BSDXI=BSDXI+1

 S ^BSDXTMP($J,BSDXI)=$C(31)

 Q

 ;

ERR(BSDXI,BSDXID,BSDXERR) ;Error processing

 S BSDXI=BSDXI+1

 S ^BSDXTMP($J,BSDXI)=BSDXERR_"^^^^"_$C(30)

 S BSDXI=BSDXI+1

 S ^BSDXTMP($J,BSDXI)=$C(31)

 Q

 ;

ETRAP ;EP Error trap entry

 I '$D(BSDXI) N BSDXI S BSDXI=999

 S BSDXI=BSDXI+1

 D ERR(BSDXI,99,70)

 Q

BSDX15    ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;

 +1       ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010

 +2       ;

 +3       ;

GRPTYP(BSDXY) ;EP

 +1       ;Called by BSDX GET ACCESS GROUP TYPES

 +2       ;Returns ADO recordset containing ACTIVE Access types ordered alphabetically

 +3       ;by Access Group

 +4       ;AccessGroupID, AccessGroup, AccessTypeID, AccessType

 +5       ;

 +6       ;Test Code:

 +7       ;D GRPTYP^BSDX15(.RES) ZW RES

 +8       ;

 +9        SET BSDXY="^BSDXTMP("_$JOB_")"

 +10       NEW BSDX1

 +11       SET BSDXI=0

 +12       SET X="ETRAP^BSDX15"

           SET @^%ZOSF("TRAP")

 +13       SET ^BSDXTMP($JOB,BSDXI)="I00020ACCESS_GROUP_TYPEID^I00020ACCESS_GROUP_ID^T00030ACCESS_GROUP^I00020ACCESS_TYPE_ID^T00030ACCESS_TYPE"_$CHAR(30)

 +14      ;

 +15      ;N BSDX0,BSDX1,BSDXNOD,BSDXGPN,BSDXTN

 +16      ;$O Through "B" x-ref of BSDX ACCESS GROUP file

 +17      ;S BSDXGPN=0 F  S BSDXGPN=$O(^BSDXAGP("B",BSDXGPN)) Q:BSDXGPN=""  D

 +18      ;. S BSDX0=$O(^BSDXAGP("B",BSDXGPN,0))

 +19      ;. Q:'+BSDX0

 +20      ;. Q:'$D(^BSDXAGP(BSDX0,0))  ;INDEX VALIDITY CHECK

 +21      ;. Q:'$D(^BSDXAGTP("B",BSDX0))

 +22      ;. ;$O through "B" x-ref of BSDX ACCESS GROUP TYPE

 +23      ;. S BSDX1=0 F  S BSDX1=$O(^BSDXAGTP("B",BSDX0,BSDX1)) Q:'+BSDX1  D

 +24      ;. . Q:'$D(^BSDXAGTP(BSDX1,0))

 +25      ;. . S BSDX2=$P(^BSDXAGTP(BSDX1,0),U,2)

 +26      ;. . Q:'+BSDX2

 +27      ;. . Q:'$D(^BSDXTYPE(BSDX2,0))

 +28      ;. . S BSDXNOD=^BSDXTYPE(BSDX2,0)

 +29      ;. . Q:$P(BSDXNOD,U,2)=1  ;INACTIVE

 +30      ;. . S BSDXTN=$P(BSDXNOD,U)

 +31      ;. . S BSDXI=BSDXI+1

 +32      ;. . S ^BSDXTMP($J,BSDXI)=BSDX1_U_BSDX0_U_BSDXGPN_U_BSDX2_U_BSDXTN_$C(30)

 +33      ;. . Q

 +34      ;. Q

 +35      ;

 +36      ;$O Through "AC" x-ref of BSDX ACCESS GROUP TYPE file

 +37       NEW BSDXAGID,BSDXAGN,BSDXATID,BSDXATN,BSDXAGTID

 +38       SET BSDXAGID=0

 +39       FOR 

               SET BSDXAGID=$ORDER(^BSDXAGTP("AC",BSDXAGID))

               IF '+BSDXAGID

                   QUIT 

               Begin DoDot:1

 +40               IF '$DATA(^BSDXAGP(BSDXAGID,0))

                       QUIT 

 +41               SET BSDXAGN=$PIECE(^BSDXAGP(BSDXAGID,0),U)

 +42               SET BSDXATID=0

                   FOR 

                       SET BSDXATID=$ORDER(^BSDXAGTP("AC",BSDXAGID,BSDXATID))

                       IF '+BSDXATID

                           QUIT 

                       Begin DoDot:2

 +43                       SET BSDXNOD=$GET(^BSDXTYPE(BSDXATID,0))

 +44                       IF BSDXNOD=""

                               QUIT 

 +45      ;Inactive

                           IF $PIECE(BSDXNOD,U,2)=1

                               QUIT 

 +46                       SET BSDXATN=$PIECE(BSDXNOD,U)

 +47                       SET BSDXAGTID=$ORDER(^BSDXAGTP("AC",BSDXAGID,BSDXATID,0))

 +48                       IF '+BSDXAGTID

                               QUIT 

 +49                       IF '$DATA(^BSDXAGTP(BSDXAGTID,0))

                               QUIT 

 +50                       SET BSDXI=BSDXI+1

 +51                       SET ^BSDXTMP($JOB,BSDXI)=BSDXAGTID_U_BSDXAGID_U_BSDXAGN_U_BSDXATID_U_BSDXATN_$CHAR(30)

 +52                       QUIT 

                       End DoDot:2

 +53               QUIT 

               End DoDot:1

 +54      ;

 +55       SET BSDXI=BSDXI+1

 +56       SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)

 +57       QUIT 

 +58      ;

ERR(BSDXI,BSDXID,BSDXERR) ;Error processing

 +1        SET BSDXI=BSDXI+1

 +2        SET ^BSDXTMP($JOB,BSDXI)=BSDXERR_"^^^^"_$CHAR(30)

 +3        SET BSDXI=BSDXI+1

 +4        SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)

 +5        QUIT 

 +6       ;

ETRAP     ;EP Error trap entry

 +1        IF '$DATA(BSDXI)

               NEW BSDXI

               SET BSDXI=999

 +2        SET BSDXI=BSDXI+1

 +3        DO ERR(BSDXI,99,70)

 +4        QUIT