- A1B2UTL ;ALB/MJK - ODS Utility Routine;
- ;;Version 1.55 (local for MAS v5 sites);;
- ;
- ADD ; -- add an entry to a file
- ; input: A1B2FL := file number
- ; A1B2DT := date/time for .01
- ; DFN := pt ifn
- ;output: Y := as define by DIC call
- ;
- S Y=-1 D FAC G ADDQ:A1B2FN=""
- K DD,D0 S X=A1B2DT,DIC(0)="L",DIC="^A1B2("_A1B2FL_"," D FILE^DICN G ADDQ:Y<0
- S DIE=DIC,DA=+Y,A1B2Y=Y,DR=".07////"_A1B2FN_";.08////"_A1B2FNME_";.12////"_DFN_";.15////1;1.01////2;1.05////"_DUZ K DIC
- D ^DIE K DR,DIE,DA,DE,DQ,DG S Y=A1B2Y
- ADDQ K A1B2FN,A1B2FNME,A1B2Y Q
- ;
- FAC ; -- find inst and get fac # and name
- ;
- N X
- S (A1B2FN,A1B2FNME)="",X=+$O(^DG(40.8,0))
- I $D(^DG(40.8,X,0)) S X=+$P(^(0),U,7) D GET
- Q
- ;
- NTL ; -- get fac # and name for nationally sign input user (IHS)
- ; input: DUZ, DUZ(2)
- ; output: A1B2FN := fac #
- ; A1B2FNME := fac name
- ; A1B2VRG := vhs&ra region #
- ;
- S (A1B2FN,A1B2FNME,A1B2VRG)=""
- I $D(DUZ(2)) S X=+DUZ(2) D GET
- Q
- ;
- KVAR ; -- kill vars set in NTL call
- K A1B2FN,A1B2FNME,A1B2VRG
- Q
- ;
- GET ; -- get fac data
- I $D(^DIC(4,X,0)),$D(^(99)) S A1B2FN=+^(99),A1B2FNME=$P(^(0),U)
- I $D(^DIC(4,X,11002)) S A1B2VRG=+^(11002)
- Q
- ;
- ON ;is the ODS software turned on?
- ; input: none
- ; output: A1B2ODS := 0 for off and 1 for on
- ;
- S A1B2ODS=0 I $D(^A1B2(11500.5,1,0)) S A1B2ODS=+$P(^(0),U,2)
- Q
- ;
- DIS ; -- screen set
- S DIS(0)="I $P(^A1B2(A1B2FL,D0,0),U,15) N X S X=$S($D(A1B2NTY):$P(A1B2NTY,U,2),1:"""") I $S(X=""""!(X=""A""):1,X=""V"":$P(^(0),U,7)=A1B2FN,X=""R"":$P(^(0),U,9)=A1B2VRG,1:0)"
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA1B2UTL 1621 printed Jan 18, 2025@03:22:41 Page 2
- A1B2UTL ;ALB/MJK - ODS Utility Routine;
- +1 ;;Version 1.55 (local for MAS v5 sites);;
- +2 ;
- ADD ; -- add an entry to a file
- +1 ; input: A1B2FL := file number
- +2 ; A1B2DT := date/time for .01
- +3 ; DFN := pt ifn
- +4 ;output: Y := as define by DIC call
- +5 ;
- +6 SET Y=-1
- DO FAC
- if A1B2FN=""
- GOTO ADDQ
- +7 KILL DD,D0
- SET X=A1B2DT
- SET DIC(0)="L"
- SET DIC="^A1B2("_A1B2FL_","
- DO FILE^DICN
- if Y<0
- GOTO ADDQ
- +8 SET DIE=DIC
- SET DA=+Y
- SET A1B2Y=Y
- SET DR=".07////"_A1B2FN_";.08////"_A1B2FNME_";.12////"_DFN_";.15////1;1.01////2;1.05////"_DUZ
- KILL DIC
- +9 DO ^DIE
- KILL DR,DIE,DA,DE,DQ,DG
- SET Y=A1B2Y
- ADDQ KILL A1B2FN,A1B2FNME,A1B2Y
- QUIT
- +1 ;
- FAC ; -- find inst and get fac # and name
- +1 ;
- +2 NEW X
- +3 SET (A1B2FN,A1B2FNME)=""
- SET X=+$ORDER(^DG(40.8,0))
- +4 IF $DATA(^DG(40.8,X,0))
- SET X=+$PIECE(^(0),U,7)
- DO GET
- +5 QUIT
- +6 ;
- NTL ; -- get fac # and name for nationally sign input user (IHS)
- +1 ; input: DUZ, DUZ(2)
- +2 ; output: A1B2FN := fac #
- +3 ; A1B2FNME := fac name
- +4 ; A1B2VRG := vhs&ra region #
- +5 ;
- +6 SET (A1B2FN,A1B2FNME,A1B2VRG)=""
- +7 IF $DATA(DUZ(2))
- SET X=+DUZ(2)
- DO GET
- +8 QUIT
- +9 ;
- KVAR ; -- kill vars set in NTL call
- +1 KILL A1B2FN,A1B2FNME,A1B2VRG
- +2 QUIT
- +3 ;
- GET ; -- get fac data
- +1 IF $DATA(^DIC(4,X,0))
- IF $DATA(^(99))
- SET A1B2FN=+^(99)
- SET A1B2FNME=$PIECE(^(0),U)
- +2 IF $DATA(^DIC(4,X,11002))
- SET A1B2VRG=+^(11002)
- +3 QUIT
- +4 ;
- ON ;is the ODS software turned on?
- +1 ; input: none
- +2 ; output: A1B2ODS := 0 for off and 1 for on
- +3 ;
- +4 SET A1B2ODS=0
- IF $DATA(^A1B2(11500.5,1,0))
- SET A1B2ODS=+$PIECE(^(0),U,2)
- +5 QUIT
- +6 ;
- DIS ; -- screen set
- +1 SET DIS(0)="I $P(^A1B2(A1B2FL,D0,0),U,15) N X S X=$S($D(A1B2NTY):$P(A1B2NTY,U,2),1:"""") I $S(X=""""!(X=""A""):1,X=""V"":$P(^(0),U,7)=A1B2FN,X=""R"":$P(^(0),U,9)=A1B2VRG,1:0)"
- +2 QUIT
- +3 ;