- USRRULA ; SLC/JER - Rule Browser actions ;2/6/98 17:12
- ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3,28,29**;Jun 20, 1997;Build 7
- EDIT ; Edit an existing rule
- N DUP,REDIT,USRDA,USRI,DIROUT,USRCHNG,USRLST,USRRBLD,SAVEDATA
- I '$D(VALMY) D EN^VALM2(XQORNOD(0))
- S (USRCHNG,USRI)=0
- F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT)
- . S USRDA=+$O(^TMP("USRRUL",$J,"INDEX",USRI,0)) Q:+USRDA'>0
- . W !!,"Editing #",+USRI,!
- . S SAVEDATA=$G(^USR(8930.1,USRDA,0))
- . D EDIT1
- . I +$G(USRCHNG) S USRLST=$S($L($G(USRLST)):$G(USRLST)_", ",1:"")_USRI
- I $G(DUP) D
- . S ^USR(8930.1,USRDA,0)=$G(SAVEDATA)
- . S VALMSG="** Item Not Edited - Duplicate of Another Rule **"
- W !,"Refreshing the list."
- I $L($G(USRLST)) D
- . S USRRBLD=$P($G(@VALMAR@(0)),U,1,4) D INIT^USRRUL,HDR^USRRUL
- K VALMY S VALMBCK="R"
- I $G(DUP) Q
- I '$G(REDIT) S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" Edited **"
- Q
- EDIT1 ; Single record edit
- ; Receives USRDA
- N DA,DIE,DR
- I '+$G(USRDA) W !,"No Classes selected." H 2 S USRCHNG=0 Q
- S DIE="^USR(8930.1,",DA=USRDA,DR="[USR DEFINE AUTHORIZATIONS]"
- D FULL^VALM1,^DIE S USRCHNG=1
- I '$D(DA) W !!,"<Business Rule DELETED>" H 3 Q
- S XUSRQ=^USR(8930.1,+DA,0),REDIT=0
- I $P(XUSRQ,"^",1)=""!($P(XUSRQ,"^",2)="")!($P(XUSRQ,"^",3)="")!(($P(XUSRQ,"^",4)="")&($P(XUSRQ,"^",6)="")) D Q
- . S ^USR(8930.1,USRDA,0)=$G(SAVEDATA)
- . S VALMSG="** Item Not Edited - Required Fields Missing **" S REDIT=1 Q
- I $P(XUSRQ,"^",5)'="" D
- . I $P(XUSRQ,"^",4)="" D Q
- . . S ($P(XUSRQ,"^",5),$P(^USR(8930.1,+DA,0),"^",5))=""
- . . S VALMSG="**USER CLASS REQ with AND FLAG -AND FLAG Removed**" S REDIT=1 Q
- . I $P(XUSRQ,"^",6)="" D Q
- . . S ($P(XUSRQ,"^",5),$P(^USR(8930.1,+DA,0),"^",5))=""
- . . S VALMSG="**USER ROLE REQ with AND FLAG -AND FLAG Removed**" S REDIT=1 Q
- S DUP=$$DUP
- Q
- ADD ; Add a member to the class
- N DA,DR,DIC,DIK,DLAYGO,DUP,X,Y,USRRBLD,USRCNT,XUSRQ D FULL^VALM1
- W !,"Please Enter a New Business Rule:",!
- S (DIC,DLAYGO)=8930.1,DIC(0)="NL",X=$$DOCPICK
- Q:+X'>0
- S X=""""_"`"_+X_""""
- D ^DIC K DLAYGO Q:+Y'>0 S DA=+Y
- S DIE=8930.1,DR="[USR DEFINE AUTHORIZATIONS]"
- D ^DIE
- I '$D(DA) S VALMSG="<Business Rule DELETED>" Q
- S DIK="^USR(8930.1,"
- S XUSRQ=^USR(8930.1,+DA,0)
- I $P(XUSRQ,"^",1)=""!($P(XUSRQ,"^",2)="")!($P(XUSRQ,"^",3)="")!(($P(XUSRQ,"^",4)="")&($P(XUSRQ,"^",6)="")) D Q
- . S VALMSG="** Item Deleted - Required Fields Missing **"
- . D ^DIK
- K DIK
- S DUP=$$DUP
- S USRCNT=+$P($G(@VALMAR@(0)),U,5)
- I +USRCNT D
- . I 'DUP D ADD^USRRUL(DA)
- . S $P(@VALMAR@(0),U,5)=+USRCNT D HDR^USRRUL I 1
- E S USRRBLD=$P($G(@VALMAR@(0)),U,1,4) D INIT^USRRUL,HDR^USRRUL
- S USRCNT=+$P($G(@VALMAR@(0)),U,5)
- S $P(@VALMAR@("#"),":",2)=+USRCNT
- S USRCHNG=1,VALMBCK="R"
- I $G(DUP) D Q
- . S DIK="^USR(8930.1,"
- . D ^DIK
- . K DIK
- . S VALMSG="** Item Deleted - Duplicate Rule **" Q
- S VALMSG="** Item "_+USRCNT_" Added **"
- Q
- DOCPICK() ; Function to pick a document for which rule will be created
- N DIC,X,Y
- ; I +$G(^TMP("USRRUL",$J,0))
- S DIC=8925.1,DIC(0)="AEMQ",DIC("A")="Select DOCUMENT DEFINITION: "
- S DIC("S")="I +$$CANPICK^TIULP(+Y),$S($P($G(^TIU(8925.1,+Y,0)),U,4)=""CO"":0,$P($G(^TIU(8925.1,+Y,0)),U,4)=""O"":0,$P($G(^TIU(8925.1,+Y,0)),U)[""ADDENDUM"":0,1:1)"
- D ^DIC K DIC("S")
- Q Y
- ;
- DUP() ; Function to determine if new or edited rule is a duplicate of an existing rule
- N DHIT,XDA,XDATA,DIK
- S (DHIT,XDA)=0 F S XDA=$O(^USR(8930.1,XDA)) Q:XDA="" Q:+XDA'>0 D Q:DHIT
- . I XDA=+DA Q
- . S XDATA=$G(^USR(8930.1,XDA,0))
- . I $P($G(^USR(8930.1,+DA,0)),"^",1,4)=$P($G(XDATA),"^",1,4)&($P($G(^USR(8930.1,+DA,0)),"^",6)=$P($G(XDATA),"^",6)) D
- . . I $P($G(^USR(8930.1,+DA,0)),"^",5)=$P($G(XDATA),"^",5) S DHIT=1 Q
- . . I $P($G(^USR(8930.1,+DA,0)),"^",5)="",$P($G(XDATA),"^",5)="!" S DHIT=1 Q
- . . I $P($G(^USR(8930.1,+DA,0)),"^",5)="!",$P($G(XDATA),"^",5)="" S DHIT=1 Q
- Q DHIT
- ;
- DELETE ; Delete a member to the class
- N USRDA,USRCHNG,USRI,USRLST,DIE,X,Y,USRRBLD K DIROUT
- D FULL^VALM1
- I '$D(VALMY) D EN^VALM2(XQORNOD(0))
- S USRI=0
- F S USRI=$O(VALMY(USRI)) Q:+USRI'>0 D Q:$D(DIROUT)
- . S USRDA=+$O(^TMP("USRRUL",$J,"INDEX",USRI,0)) Q:+USRDA'>0
- . W !!,"Deleting #",+USRI,!
- . D DELETE1(USRDA)
- . S:+USRCHNG USRLST=$S(+$G(USRLST):USRLST_", ",1:"")_+USRI
- I +$G(USRLST) D
- . S USRRBLD=$P($G(@VALMAR@(0)),U,1,4) D INIT^USRRUL,HDR^USRRUL
- K VALMY S VALMBCK="R"
- S VALMSG="** "_$S($L($G(USRLST)):"Item"_$S($L($G(USRLST),",")>1:"s ",1:" ")_$G(USRLST),1:"Nothing")_" deleted **"
- Q
- DELETE1(DA) ; Delete one member from a class
- N DIE,DR,USRI,USRULE D XLATE^USRAEDT(.USRULE,+DA)
- I $G(USRULE)']"" W !,"Record #",DA," NOT FOUND!" Q
- W !,"Removing the rule:",!
- F USRI=1:1:$L(USRULE,"|") W !,$P(USRULE,"|",USRI)
- W !
- I '$$READ^USRU("Y","Are you SURE","NO") S USRCHNG=0 W !,"Business Rule NOT Removed." Q
- W !,"Deleting Business Rule"
- S USRCHNG=1
- S DIK="^USR(8930.1," D ^DIK K DIK W "."
- Q
- USRRULA ; SLC/JER - Rule Browser actions ;2/6/98 17:12
- +1 ;;1.0;AUTHORIZATION/SUBSCRIPTION;**3,28,29**;Jun 20, 1997;Build 7
- EDIT ; Edit an existing rule
- +1 NEW DUP,REDIT,USRDA,USRI,DIROUT,USRCHNG,USRLST,USRRBLD,SAVEDATA
- +2 IF '$DATA(VALMY)
- DO EN^VALM2(XQORNOD(0))
- +3 SET (USRCHNG,USRI)=0
- +4 FOR
- SET USRI=$ORDER(VALMY(USRI))
- IF +USRI'>0
- QUIT
- Begin DoDot:1
- +5 SET USRDA=+$ORDER(^TMP("USRRUL",$JOB,"INDEX",USRI,0))
- IF +USRDA'>0
- QUIT
- +6 WRITE !!,"Editing #",+USRI,!
- +7 SET SAVEDATA=$GET(^USR(8930.1,USRDA,0))
- +8 DO EDIT1
- +9 IF +$GET(USRCHNG)
- SET USRLST=$SELECT($LENGTH($GET(USRLST)):$GET(USRLST)_", ",1:"")_USRI
- End DoDot:1
- IF $DATA(DIROUT)
- QUIT
- +10 IF $GET(DUP)
- Begin DoDot:1
- +11 SET ^USR(8930.1,USRDA,0)=$GET(SAVEDATA)
- +12 SET VALMSG="** Item Not Edited - Duplicate of Another Rule **"
- End DoDot:1
- +13 WRITE !,"Refreshing the list."
- +14 IF $LENGTH($GET(USRLST))
- Begin DoDot:1
- +15 SET USRRBLD=$PIECE($GET(@VALMAR@(0)),U,1,4)
- DO INIT^USRRUL
- DO HDR^USRRUL
- End DoDot:1
- +16 KILL VALMY
- SET VALMBCK="R"
- +17 IF $GET(DUP)
- QUIT
- +18 IF '$GET(REDIT)
- SET VALMSG="** "_$SELECT($LENGTH($GET(USRLST)):"Item"_$SELECT($LENGTH($GET(USRLST),",")>1:"s ",1:" ")_$GET(USRLST),1:"Nothing")_" Edited **"
- +19 QUIT
- EDIT1 ; Single record edit
- +1 ; Receives USRDA
- +2 NEW DA,DIE,DR
- +3 IF '+$GET(USRDA)
- WRITE !,"No Classes selected."
- HANG 2
- SET USRCHNG=0
- QUIT
- +4 SET DIE="^USR(8930.1,"
- SET DA=USRDA
- SET DR="[USR DEFINE AUTHORIZATIONS]"
- +5 DO FULL^VALM1
- DO ^DIE
- SET USRCHNG=1
- +6 IF '$DATA(DA)
- WRITE !!,"<Business Rule DELETED>"
- HANG 3
- QUIT
- +7 SET XUSRQ=^USR(8930.1,+DA,0)
- SET REDIT=0
- +8 IF $PIECE(XUSRQ,"^",1)=""!($PIECE(XUSRQ,"^",2)="")!($PIECE(XUSRQ,"^",3)="")!(($PIECE(XUSRQ,"^",4)="")&($PIECE(XUSRQ,"^",6)=""))
- Begin DoDot:1
- +9 SET ^USR(8930.1,USRDA,0)=$GET(SAVEDATA)
- +10 SET VALMSG="** Item Not Edited - Required Fields Missing **"
- SET REDIT=1
- QUIT
- End DoDot:1
- QUIT
- +11 IF $PIECE(XUSRQ,"^",5)'=""
- Begin DoDot:1
- +12 IF $PIECE(XUSRQ,"^",4)=""
- Begin DoDot:2
- +13 SET ($PIECE(XUSRQ,"^",5),$PIECE(^USR(8930.1,+DA,0),"^",5))=""
- +14 SET VALMSG="**USER CLASS REQ with AND FLAG -AND FLAG Removed**"
- SET REDIT=1
- QUIT
- End DoDot:2
- QUIT
- +15 IF $PIECE(XUSRQ,"^",6)=""
- Begin DoDot:2
- +16 SET ($PIECE(XUSRQ,"^",5),$PIECE(^USR(8930.1,+DA,0),"^",5))=""
- +17 SET VALMSG="**USER ROLE REQ with AND FLAG -AND FLAG Removed**"
- SET REDIT=1
- QUIT
- End DoDot:2
- QUIT
- End DoDot:1
- +18 SET DUP=$$DUP
- +19 QUIT
- ADD ; Add a member to the class
- +1 NEW DA,DR,DIC,DIK,DLAYGO,DUP,X,Y,USRRBLD,USRCNT,XUSRQ
- DO FULL^VALM1
- +2 WRITE !,"Please Enter a New Business Rule:",!
- +3 SET (DIC,DLAYGO)=8930.1
- SET DIC(0)="NL"
- SET X=$$DOCPICK
- +4 IF +X'>0
- QUIT
- +5 SET X=""""_"`"_+X_""""
- +6 DO ^DIC
- KILL DLAYGO
- IF +Y'>0
- QUIT
- SET DA=+Y
- +7 SET DIE=8930.1
- SET DR="[USR DEFINE AUTHORIZATIONS]"
- +8 DO ^DIE
- +9 IF '$DATA(DA)
- SET VALMSG="<Business Rule DELETED>"
- QUIT
- +10 SET DIK="^USR(8930.1,"
- +11 SET XUSRQ=^USR(8930.1,+DA,0)
- +12 IF $PIECE(XUSRQ,"^",1)=""!($PIECE(XUSRQ,"^",2)="")!($PIECE(XUSRQ,"^",3)="")!(($PIECE(XUSRQ,"^",4)="")&($PIECE(XUSRQ,"^",6)=""))
- Begin DoDot:1
- +13 SET VALMSG="** Item Deleted - Required Fields Missing **"
- +14 DO ^DIK
- End DoDot:1
- QUIT
- +15 KILL DIK
- +16 SET DUP=$$DUP
- +17 SET USRCNT=+$PIECE($GET(@VALMAR@(0)),U,5)
- +18 IF +USRCNT
- Begin DoDot:1
- +19 IF 'DUP
- DO ADD^USRRUL(DA)
- +20 SET $PIECE(@VALMAR@(0),U,5)=+USRCNT
- DO HDR^USRRUL
- IF 1
- End DoDot:1
- +21 IF '$TEST
- SET USRRBLD=$PIECE($GET(@VALMAR@(0)),U,1,4)
- DO INIT^USRRUL
- DO HDR^USRRUL
- +22 SET USRCNT=+$PIECE($GET(@VALMAR@(0)),U,5)
- +23 SET $PIECE(@VALMAR@("#"),":",2)=+USRCNT
- +24 SET USRCHNG=1
- SET VALMBCK="R"
- +25 IF $GET(DUP)
- Begin DoDot:1
- +26 SET DIK="^USR(8930.1,"
- +27 DO ^DIK
- +28 KILL DIK
- +29 SET VALMSG="** Item Deleted - Duplicate Rule **"
- QUIT
- End DoDot:1
- QUIT
- +30 SET VALMSG="** Item "_+USRCNT_" Added **"
- +31 QUIT
- DOCPICK() ; Function to pick a document for which rule will be created
- +1 NEW DIC,X,Y
- +2 ; I +$G(^TMP("USRRUL",$J,0))
- +3 SET DIC=8925.1
- SET DIC(0)="AEMQ"
- SET DIC("A")="Select DOCUMENT DEFINITION: "
- +4 SET DIC("S")="I +$$CANPICK^TIULP(+Y),$S($P($G(^TIU(8925.1,+Y,0)),U,4)=""CO"":0,$P($G(^TIU(8925.1,+Y,0)),U,4)=""O"":0,$P($G(^TIU(8925.1,+Y,0)),U)[""ADDENDUM"":0,1:1)"
- +5 DO ^DIC
- KILL DIC("S")
- +6 QUIT Y
- +7 ;
- DUP() ; Function to determine if new or edited rule is a duplicate of an existing rule
- +1 NEW DHIT,XDA,XDATA,DIK
- +2 SET (DHIT,XDA)=0
- FOR
- SET XDA=$ORDER(^USR(8930.1,XDA))
- IF XDA=""
- QUIT
- IF +XDA'>0
- QUIT
- Begin DoDot:1
- +3 IF XDA=+DA
- QUIT
- +4 SET XDATA=$GET(^USR(8930.1,XDA,0))
- +5 IF $PIECE($GET(^USR(8930.1,+DA,0)),"^",1,4)=$PIECE($GET(XDATA),"^",1,4)&($PIECE($GET(^USR(8930.1,+DA,0)),"^",6)=$PIECE($GET(XDATA),"^",6))
- Begin DoDot:2
- +6 IF $PIECE($GET(^USR(8930.1,+DA,0)),"^",5)=$PIECE($GET(XDATA),"^",5)
- SET DHIT=1
- QUIT
- +7 IF $PIECE($GET(^USR(8930.1,+DA,0)),"^",5)=""
- IF $PIECE($GET(XDATA),"^",5)="!"
- SET DHIT=1
- QUIT
- +8 IF $PIECE($GET(^USR(8930.1,+DA,0)),"^",5)="!"
- IF $PIECE($GET(XDATA),"^",5)=""
- SET DHIT=1
- QUIT
- End DoDot:2
- End DoDot:1
- IF DHIT
- QUIT
- +9 QUIT DHIT
- +10 ;
- DELETE ; Delete a member to the class
- +1 NEW USRDA,USRCHNG,USRI,USRLST,DIE,X,Y,USRRBLD
- KILL DIROUT
- +2 DO FULL^VALM1
- +3 IF '$DATA(VALMY)
- DO EN^VALM2(XQORNOD(0))
- +4 SET USRI=0
- +5 FOR
- SET USRI=$ORDER(VALMY(USRI))
- IF +USRI'>0
- QUIT
- Begin DoDot:1
- +6 SET USRDA=+$ORDER(^TMP("USRRUL",$JOB,"INDEX",USRI,0))
- IF +USRDA'>0
- QUIT
- +7 WRITE !!,"Deleting #",+USRI,!
- +8 DO DELETE1(USRDA)
- +9 IF +USRCHNG
- SET USRLST=$SELECT(+$GET(USRLST):USRLST_", ",1:"")_+USRI
- End DoDot:1
- IF $DATA(DIROUT)
- QUIT
- +10 IF +$GET(USRLST)
- Begin DoDot:1
- +11 SET USRRBLD=$PIECE($GET(@VALMAR@(0)),U,1,4)
- DO INIT^USRRUL
- DO HDR^USRRUL
- End DoDot:1
- +12 KILL VALMY
- SET VALMBCK="R"
- +13 SET VALMSG="** "_$SELECT($LENGTH($GET(USRLST)):"Item"_$SELECT($LENGTH($GET(USRLST),",")>1:"s ",1:" ")_$GET(USRLST),1:"Nothing")_" deleted **"
- +14 QUIT
- DELETE1(DA) ; Delete one member from a class
- +1 NEW DIE,DR,USRI,USRULE
- DO XLATE^USRAEDT(.USRULE,+DA)
- +2 IF $GET(USRULE)']""
- WRITE !,"Record #",DA," NOT FOUND!"
- QUIT
- +3 WRITE !,"Removing the rule:",!
- +4 FOR USRI=1:1:$LENGTH(USRULE,"|")
- WRITE !,$PIECE(USRULE,"|",USRI)
- +5 WRITE !
- +6 IF '$$READ^USRU("Y","Are you SURE","NO")
- SET USRCHNG=0
- WRITE !,"Business Rule NOT Removed."
- QUIT
- +7 WRITE !,"Deleting Business Rule"
- +8 SET USRCHNG=1
- +9 SET DIK="^USR(8930.1,"
- DO ^DIK
- KILL DIK
- WRITE "."
- +10 QUIT
