- XUDIV ; jch ; 12 Mar 99 11:02; check, setup, or switch DUZ(2)
- ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- ;CHCS TOOLS_430; GEN 2; 3-MAR-1994
- ;COPYRIGHT 1988, 1989, 1990, 1993 SAIC
- I '$D(^DG(40.8,0))#2 S DUZ(2)=0 Q
- DUZ ; put allowable divisions in DUZ(2,x), DUZ(2)=current division number signed onto
- ; If no Divisions entered in USER file, all divisions allowed ; If divisions entered in USER file, only those divisions allowed
- N A,Y ; protect for MenuMan
- S:'$D(Z(0)) Z(0)=$G(^DIC(3,+$G(DUZ),0)) D DATE^XQ1
- K DUZ(2) S XUDIV=-1 I '$O(^DIC(3,+DUZ,2,0)) D ; No entries in user file - all are allowable
- .S I=0 F S I=$O(^DG(40.8,I)) Q:'I I '$G(^(I,28)) S DUZ(2,I)=$G(^(0)),XUDIV=XUDIV+1
- E D ; entries in user file, get allowables
- .S I=0 F S I=$O(^DIC(3,+DUZ,2,I)) Q:'I I '$G(^DG(40.8,I,28)) S:$D(^(0)) DUZ(2,I)=^(0),XUDIV=XUDIV+1
- S DUZ(2)=$P(Z(0),U,16),DUZ(2)=$S(DUZ(2):DUZ(2),'XUDIV:$O(DUZ(2,0)),1:"")
- I '$P($G(DUZ("AG")),U,5) G SNGL ; Check if site parameter switch off - SIR #25662 JLL
- I $D(DUZ(2))'=11 W !,"Contact site manager; you must have an active allowable division to sign on."_$C(7),! H 2 G H^XUS ; SIR 25662
- G:XUDIV<1 SNGL ;Check if only one allowable division. - SIR 25662
- I 'DUZ(2)!'$D(DUZ(2,+DUZ(2))) W !!,"You may avoid the next prompt by entering a DEFAULT DIVISION for yourself after invoking the EDIT USER CHARACTERISTICS option."
- I D ASK I +Y'>0 W !!,"You have no assigned division - an entry is mandatory to continue."_$C(7),! H 2 G H^XUS
- S DUZ(2)=+DUZ(2)_U_XUDIV_U_$P(DUZ(2,+DUZ(2)),U,1) ; 1st piece is internal of current division, 2nd piece is true if allowed in another division, 3rd is division name
- K XUDIV Q
- SNGL ; Site parameter switch off, set duz(2) and go on your merry way
- S Y=$O(DUZ(2,"")) I 'Y S DUZ(2)="0^0^UNKNOWN" K XUDIV Q
- S DUZ(2)=+Y_"^0^"_$P(DUZ(2,+Y),U) K XUDIV
- Q
- ;
- SWTCH ;Change divisions
- I '$D(^DG(40.8,0))#2 W !,"You have no division file defined",! Q
- N (DIJC,DIJKT,DIJTT,DT,DTIME,DUZ,DWAP,DWK,DWXY,DWXYXY,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOSR,IOST,IOT,IOX,IOXY,IOY,LRWE,POP,U,XQNOSW) ; protect application variables
- W:+DUZ(2) !!!,"You are currently signed onto Division: ",$P(DUZ(2),U,3),"."
- I '$P(DUZ(2),U,2) W !,"This is the only Division you may currently access.",!! D Q
- .I $G(LRWE)]"",'$D(XQNOSW) S LRWE=$$^LRUTWE("L") ; Lab hook
- ; Application may disallow switching - they can put their own message in XQNOSW
- I $D(XQNOSW)#2 W !!,"Switching divisions has been turned off while you are performing these tasks."_$C(7),!,XQNOSW,! Q
- D ASK
- I $G(LRWE)]"",'$G(XQNOPE) S LRWE=$$^LRUTWE("L") ; Lab hook
- Q
- ASK ;
- K DIC,XQCNT S XQCNT=0,DIC="^DG(40.8,",DIC(0)="AEMQ",DIC("A")="Select DIVISION: ",DIC("S")="I $D(DUZ(2,+Y))" ; Screen out unallowables
- ASK1 ;
- W !! D ^DIC
- I +Y>0 K DIC W !,"You are now signed onto Division: "_$P(Y,U,2),".",! D
- .S DUZ(2)=+Y_U_$P(DUZ(2),U,2)_U_$P(DUZ(2,+Y),U),^ZUTL("XQ",$J,"DUZ(2)")=DUZ(2)
- .S I=0 F S I=$O(^ZUTL("XQ",$J,I)),X=$G(^(I)) Q:'I I $P(X,U,5)="M",$P(X,U,7)]"",'$$^XUSEC($P(X,U,7)) Q:I=$G(^ZUTL("XQ",$J,"T")) W "But your divisional access is restricted prior to the ",$P(X,U,3),! S ^("T")=I Q
- I +Y>0 K XQCNT Q
- I $G(DUZ(2)) K DIC W !,"No change - you are still in Division: "_$P(DUZ(2),U,3)_".",! S XQNOPE=1
- I '$G(DUZ(2)) S XQCNT=XQCNT+1 W !!,"You have not selected a division - an entry is mandatory to continue."_$C(7),! G:XQCNT<3&($G(X)'=U)&'$G(DTOUT) ASK1 H 3 G H^XUS
- Q
- ALWBL ; called from XUSMGR to find user allowable divisions, set up array XUDIV for USER INQUIRY display
- K XUDIV I '$O(^DIC(3,XQD,2,0)) D ;No entries in user file - all are allowable
- .S I=0 F S I=$O(^DG(40.8,I)) Q:'I S:'$G(^DG(40.8,I,28)) XUDIV(I)=$P($G(^DG(40.8,I,0)),U,1)
- E D ;entries in user file - get allowables outta there
- .S I=0 F S I=$O(^DIC(3,XQD,2,I)) Q:'I S:$D(^DG(40.8,I,0)) XUDIV(I)=$P($G(^DG(40.8,I,0)),U,1)
- Q
- XQTSK ;Set up DUZ(2) array for tasked jobs, it may not be set to the right div - entry point from XQ1
- G:$O(DUZ(2,0)) RESET K DUZ(2) S XUDIV=-1 I '$O(^DIC(3,+DUZ,2,0)) D ;No entries in user file - all are allowable
- .S I=0 F S I=$O(^DG(40.8,I)) Q:'I S:'$G(^DG(40.8,I,28)) DUZ(2,I)=$G(^DG(40.8,I,0)),XUDIV=XUDIV+1
- E D ;entries in user file - get allowables outta there
- .S I=0 F S I=$O(^DIC(3,+DUZ,2,I)) Q:'I I $D(^DG(40.8,I,0)),'$G(^DG(40.8,I,28)) S DUZ(2,I)=$G(^DG(40.8,I,0)),XUDIV=XUDIV+1
- RESET ;
- S:'$D(XUDIV) XUDIV=$S($D(DUZ(2))#2:$P(DUZ(2,+$P(XQT,U,2)),U,2),1:0)
- I $D(DUZ(2,+$P(XQT,U,2))) S (XQTDIV,DUZ(2))=+$P(XQT,U,2)_U_XUDIV_U_$P(DUZ(2,+$P(XQT,U,2)),U,1) K XUDIV Q ; force duz(2) to be same as division tasked from
- S DUZ(2,+$P(XQT,U,2))=$G(^DG(40.8,+$P(XQT,U,2),0)),DUZ(2)=+$P(XQT,U,2)_U_XUDIV_U_$P(DUZ(2,+$P(XQT,U,2)),U,1) ; don't know who user is so set DUZ(2) for this division
- K XUDIV S XQTDIV=DUZ(2) ; XQTDIV signals applications this option is divisionally tasked
- Q
- CHK ; check node for input template XUADDEDITUSER
- S X=$S($D(DG("0;16")):DG("0;16"),1:$P($G(^DIC(3,DA,0)),U,16)) Q:'$L(X) ;find value of default div
- I $O(^DIC(3,DA,2,0)),'$D(^DIC(3,DA,2,+X)) W !,"The default division is no longer valid - please correct."_$C(7) H 2 S Y=28.2
- Q
- XUDIV ; jch ; 12 Mar 99 11:02; check, setup, or switch DUZ(2)
- +1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- +2 ;CHCS TOOLS_430; GEN 2; 3-MAR-1994
- +3 ;COPYRIGHT 1988, 1989, 1990, 1993 SAIC
- +4 IF '$DATA(^DG(40.8,0))#2
- SET DUZ(2)=0
- QUIT
- DUZ ; put allowable divisions in DUZ(2,x), DUZ(2)=current division number signed onto
- +1 ; If no Divisions entered in USER file, all divisions allowed ; If divisions entered in USER file, only those divisions allowed
- +2 ; protect for MenuMan
- NEW A,Y
- +3 IF '$DATA(Z(0))
- SET Z(0)=$GET(^DIC(3,+$GET(DUZ),0))
- DO DATE^XQ1
- +4 ; No entries in user file - all are allowable
- KILL DUZ(2)
- SET XUDIV=-1
- IF '$ORDER(^DIC(3,+DUZ,2,0))
- Begin DoDot:1
- +5 SET I=0
- FOR
- SET I=$ORDER(^DG(40.8,I))
- IF 'I
- QUIT
- IF '$GET(^(I,28))
- SET DUZ(2,I)=$GET(^(0))
- SET XUDIV=XUDIV+1
- End DoDot:1
- +6 ; entries in user file, get allowables
- IF '$TEST
- Begin DoDot:1
- +7 SET I=0
- FOR
- SET I=$ORDER(^DIC(3,+DUZ,2,I))
- IF 'I
- QUIT
- IF '$GET(^DG(40.8,I,28))
- IF $DATA(^(0))
- SET DUZ(2,I)=^(0)
- SET XUDIV=XUDIV+1
- End DoDot:1
- +8 SET DUZ(2)=$PIECE(Z(0),U,16)
- SET DUZ(2)=$SELECT(DUZ(2):DUZ(2),'XUDIV:$ORDER(DUZ(2,0)),1:"")
- +9 ; Check if site parameter switch off - SIR #25662 JLL
- IF '$PIECE($GET(DUZ("AG")),U,5)
- GOTO SNGL
- +10 ; SIR 25662
- IF $DATA(DUZ(2))'=11
- WRITE !,"Contact site manager; you must have an active allowable division to sign on."_$CHAR(7),!
- HANG 2
- GOTO H^XUS
- +11 ;Check if only one allowable division. - SIR 25662
- IF XUDIV<1
- GOTO SNGL
- +12 IF 'DUZ(2)!'$DATA(DUZ(2,+DUZ(2)))
- WRITE !!,"You may avoid the next prompt by entering a DEFAULT DIVISION for yourself after invoking the EDIT USER CHARACTERISTICS option."
- +13 IF $TEST
- DO ASK
- IF +Y'>0
- WRITE !!,"You have no assigned division - an entry is mandatory to continue."_$CHAR(7),!
- HANG 2
- GOTO H^XUS
- +14 ; 1st piece is internal of current division, 2nd piece is true if allowed in another division, 3rd is division name
- SET DUZ(2)=+DUZ(2)_U_XUDIV_U_$PIECE(DUZ(2,+DUZ(2)),U,1)
- +15 KILL XUDIV
- QUIT
- SNGL ; Site parameter switch off, set duz(2) and go on your merry way
- +1 SET Y=$ORDER(DUZ(2,""))
- IF 'Y
- SET DUZ(2)="0^0^UNKNOWN"
- KILL XUDIV
- QUIT
- +2 SET DUZ(2)=+Y_"^0^"_$PIECE(DUZ(2,+Y),U)
- KILL XUDIV
- +3 QUIT
- +4 ;
- SWTCH ;Change divisions
- +1 IF '$DATA(^DG(40.8,0))#2
- WRITE !,"You have no division file defined",!
- QUIT
- +2 ; protect application variables
- NEW (DIJC,DIJKT,DIJTT,DT,DTIME,DUZ,DWAP,DWK,DWXY,DWXYXY,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOSR,IOST,IOT,IOX,IOXY,IOY,LRWE,POP,U,XQNOSW)
- +3 IF +DUZ(2)
- WRITE !!!,"You are currently signed onto Division: ",$PIECE(DUZ(2),U,3),"."
- +4 IF '$PIECE(DUZ(2),U,2)
- WRITE !,"This is the only Division you may currently access.",!!
- Begin DoDot:1
- +5 ; Lab hook
- IF $GET(LRWE)]""
- IF '$DATA(XQNOSW)
- SET LRWE=$$^LRUTWE("L")
- End DoDot:1
- QUIT
- +6 ; Application may disallow switching - they can put their own message in XQNOSW
- +7 IF $DATA(XQNOSW)#2
- WRITE !!,"Switching divisions has been turned off while you are performing these tasks."_$CHAR(7),!,XQNOSW,!
- QUIT
- +8 DO ASK
- +9 ; Lab hook
- IF $GET(LRWE)]""
- IF '$GET(XQNOPE)
- SET LRWE=$$^LRUTWE("L")
- +10 QUIT
- ASK ;
- +1 ; Screen out unallowables
- KILL DIC,XQCNT
- SET XQCNT=0
- SET DIC="^DG(40.8,"
- SET DIC(0)="AEMQ"
- SET DIC("A")="Select DIVISION: "
- SET DIC("S")="I $D(DUZ(2,+Y))"
- ASK1 ;
- +1 WRITE !!
- DO ^DIC
- +2 IF +Y>0
- KILL DIC
- WRITE !,"You are now signed onto Division: "_$PIECE(Y,U,2),".",!
- Begin DoDot:1
- +3 SET DUZ(2)=+Y_U_$PIECE(DUZ(2),U,2)_U_$PIECE(DUZ(2,+Y),U)
- SET ^ZUTL("XQ",$JOB,"DUZ(2)")=DUZ(2)
- +4 SET I=0
- FOR
- SET I=$ORDER(^ZUTL("XQ",$JOB,I))
- SET X=$GET(^(I))
- IF 'I
- QUIT
- IF $PIECE(X,U,5)="M"
- IF $PIECE(X,U,7)]""
- IF '$$^XUSEC($PIECE(X,U,7))
- IF I=$GET(^ZUTL("XQ",$JOB,"T"))
- QUIT
- WRITE "But your divisional access is restricted prior to the ",$PIECE(X,U,3),!
- SET ^("T")=I
- QUIT
- End DoDot:1
- +5 IF +Y>0
- KILL XQCNT
- QUIT
- +6 IF $GET(DUZ(2))
- KILL DIC
- WRITE !,"No change - you are still in Division: "_$PIECE(DUZ(2),U,3)_".",!
- SET XQNOPE=1
- +7 IF '$GET(DUZ(2))
- SET XQCNT=XQCNT+1
- WRITE !!,"You have not selected a division - an entry is mandatory to continue."_$CHAR(7),!
- IF XQCNT<3&($GET(X)'=U)&'$GET(DTOUT)
- GOTO ASK1
- HANG 3
- GOTO H^XUS
- +8 QUIT
- ALWBL ; called from XUSMGR to find user allowable divisions, set up array XUDIV for USER INQUIRY display
- +1 ;No entries in user file - all are allowable
- KILL XUDIV
- IF '$ORDER(^DIC(3,XQD,2,0))
- Begin DoDot:1
- +2 SET I=0
- FOR
- SET I=$ORDER(^DG(40.8,I))
- IF 'I
- QUIT
- IF '$GET(^DG(40.8,I,28))
- SET XUDIV(I)=$PIECE($GET(^DG(40.8,I,0)),U,1)
- End DoDot:1
- +3 ;entries in user file - get allowables outta there
- IF '$TEST
- Begin DoDot:1
- +4 SET I=0
- FOR
- SET I=$ORDER(^DIC(3,XQD,2,I))
- IF 'I
- QUIT
- IF $DATA(^DG(40.8,I,0))
- SET XUDIV(I)=$PIECE($GET(^DG(40.8,I,0)),U,1)
- End DoDot:1
- +5 QUIT
- XQTSK ;Set up DUZ(2) array for tasked jobs, it may not be set to the right div - entry point from XQ1
- +1 ;No entries in user file - all are allowable
- IF $ORDER(DUZ(2,0))
- GOTO RESET
- KILL DUZ(2)
- SET XUDIV=-1
- IF '$ORDER(^DIC(3,+DUZ,2,0))
- Begin DoDot:1
- +2 SET I=0
- FOR
- SET I=$ORDER(^DG(40.8,I))
- IF 'I
- QUIT
- IF '$GET(^DG(40.8,I,28))
- SET DUZ(2,I)=$GET(^DG(40.8,I,0))
- SET XUDIV=XUDIV+1
- End DoDot:1
- +3 ;entries in user file - get allowables outta there
- IF '$TEST
- Begin DoDot:1
- +4 SET I=0
- FOR
- SET I=$ORDER(^DIC(3,+DUZ,2,I))
- IF 'I
- QUIT
- IF $DATA(^DG(40.8,I,0))
- IF '$GET(^DG(40.8,I,28))
- SET DUZ(2,I)=$GET(^DG(40.8,I,0))
- SET XUDIV=XUDIV+1
- End DoDot:1
- RESET ;
- +1 IF '$DATA(XUDIV)
- SET XUDIV=$SELECT($DATA(DUZ(2))#2:$PIECE(DUZ(2,+$PIECE(XQT,U,2)),U,2),1:0)
- +2 ; force duz(2) to be same as division tasked from
- IF $DATA(DUZ(2,+$PIECE(XQT,U,2)))
- SET (XQTDIV,DUZ(2))=+$PIECE(XQT,U,2)_U_XUDIV_U_$PIECE(DUZ(2,+$PIECE(XQT,U,2)),U,1)
- KILL XUDIV
- QUIT
- +3 ; don't know who user is so set DUZ(2) for this division
- SET DUZ(2,+$PIECE(XQT,U,2))=$GET(^DG(40.8,+$PIECE(XQT,U,2),0))
- SET DUZ(2)=+$PIECE(XQT,U,2)_U_XUDIV_U_$PIECE(DUZ(2,+$PIECE(XQT,U,2)),U,1)
- +4 ; XQTDIV signals applications this option is divisionally tasked
- KILL XUDIV
- SET XQTDIV=DUZ(2)
- +5 QUIT
- CHK ; check node for input template XUADDEDITUSER
- +1 ;find value of default div
- SET X=$SELECT($DATA(DG("0;16")):DG("0;16"),1:$PIECE($GET(^DIC(3,DA,0)),U,16))
- IF '$LENGTH(X)
- QUIT
- +2 IF $ORDER(^DIC(3,DA,2,0))
- IF '$DATA(^DIC(3,DA,2,+X))
- WRITE !,"The default division is no longer valid - please correct."_$CHAR(7)
- HANG 2
- SET Y=28.2
- +3 QUIT
