VASITE1 ;ALB/AAS - LOAD VASITE FILE WITH DATA ; 10-FEB-92
;;5.3;Registration;;Aug 13, 1993
;
% S:'$D(DTIME) DTIME=300 S U="^"
; -load file 389.9
Q:$O(^VA(389.9,0))
;D:'$D(VAPRIM) PRIM
W !!,"<<< Updating Time Sensitive Station Number file for all Medical Center divisions",!
S (VADIV,VACNT)=0 F S VADIV=$O(^DG(40.8,VADIV)) Q:'VADIV I '$D(VA(389.9,"C",VADIV)) D
.S VASITE=$P($G(^DG(40.8,VADIV,0)),U,2) I VASITE="" S VASITE=$P($G(^DIC(4,$P(^DG(40.8,VADIV,0),U,7),99)),U)
.I VASITE'?3N.AN W !!,"Division ",$P(^DG(40.8,VADIV,0),"^")," has station number in incorrect format",!,"and can't be added to file. Use the option 'Station Number (Time Sensitive)",!,"Enter/Edit' to complete entry." Q
.K DD,DO
.S VACNT=VACNT+1,X=VACNT,DIC(0)="L",DIC="^VA(389.9," D FILE^DICN Q:+Y<1 W ".."
.S DA=+Y,DR=".02////2800101;.03////"_VADIV_";.04////"_VASITE S:VASITE=+VASITE&('$D(VAPRIM)) DR=DR_";.05////1;",VAPRIM=1 S DIE="^VA(389.9,"
.D ^DIE
.K DIC,DIE,DA,DR
.Q
Q
;
PRIM S DIR(0)="N^.5:1.5:4",DIR("A")="PRIMARY DIVISION"
S DIR("A",1)="If you know your stations PRIMARY DIVISION, you may"
S DIR("A",2)="enter it now. If not it can be entered at a later time."
S DIR("A",3)="However, it must be entered before the Billing software is used.",DIR("A",4)=" "
D ^DIR K DIR Q:$D(DIRUT)
I +Y S VAPRIM=+Y
Q
;
NEW ; -- add new entry to time sensitive file when adding a new division
; input: VASITE("NEW")=Y (after adding new entry)
; =internal number in 40.8^name^1
; -- called from DGPAR1
;
N X,Y,DO,DD,DIC,DIE,DA,DR,DINUM S Y=VASITE("NEW")
S VASITE("OK")=0
G:'Y!('$P(Y,"^",3)) NEWQ
S VADIV=+Y I $D(^VA(389.9,"C",VADIV)) G NEWQ ;not a new entry.
;
S VASITE=$P($G(^DG(40.8,VADIV,0)),U,2) I VASITE="" S VASITE=$P($G(^DIC(4,$P(^DG(40.8,VADIV,0),U,7),99)),U) I VASITE="" G NEWQ ;no station number or facility entered
;
I VASITE'?3N.AN S $P(VASITE("OK"),"^",2)="Division "_$P(^DG(40.8,VADIV,0),"^")_" has station number in incorrect format." G NEWQ
;
ADD ; -add new entry
;
L +^VA(389.9,0):10 I '$T S $P(VASITE("OK"),"^",2)="Another user appears to be adding an entry" G NEWQ
S X=$P($G(^VA(389.9,0)),"^",3)
L -^VA(389.9,0)
K DD,DO,DIC,DR S DLAYGO=389.9,DIC(0)="L",DIC="^VA(389.9,"
;
F X=X:1 L:$D(VAIEN) -^VA(389.9,VAIEN) I X>0,'$D(^VA(389.9,X)) S VAIEN=X L +^VA(389.9,X,0) I $T,'$D(^VA(389.9,X,0)) S DINUM=X D FILE^DICN I +Y>0 D Q
.S VASITE("OK")=1
;
EDIT ;
S DA=+Y,DR=".02////"_DT_";.03////"_VADIV_";.04////"_VASITE,DIE="^VA(389.9,"
D ^DIE
;
NEWQ ;
I '+VASITE("OK") D
.W !!?5,">>> An unsuccessful attempt was made to also add a new entry to"
.W !?5," STATION NUMBER (TIME SENSITIVE) [#389.9] file for this division."
.I $P(VASITE("OK"),U,2)]"" W !?5," *** ",$P(VASITE("OK"),U,2)," ***"
.W !!?5,">>> Please contact your IRM service after entering division data.",!,*7
K VAIEN,VASITE,VADIV
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVASITE1 2920 printed Apr 09, 2024@21:53:51 Page 2
VASITE1 ;ALB/AAS - LOAD VASITE FILE WITH DATA ; 10-FEB-92
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;
% if '$DATA(DTIME)
SET DTIME=300
SET U="^"
+1 ; -load file 389.9
+2 if $ORDER(^VA(389.9,0))
QUIT
+3 ;D:'$D(VAPRIM) PRIM
+4 WRITE !!,"<<< Updating Time Sensitive Station Number file for all Medical Center divisions",!
+5 SET (VADIV,VACNT)=0
FOR
SET VADIV=$ORDER(^DG(40.8,VADIV))
if 'VADIV
QUIT
IF '$DATA(VA(389.9,"C",VADIV))
Begin DoDot:1
+6 SET VASITE=$PIECE($GET(^DG(40.8,VADIV,0)),U,2)
IF VASITE=""
SET VASITE=$PIECE($GET(^DIC(4,$PIECE(^DG(40.8,VADIV,0),U,7),99)),U)
+7 IF VASITE'?3N.AN
WRITE !!,"Division ",$PIECE(^DG(40.8,VADIV,0),"^")," has station number in incorrect format",!,"and can't be added to file. Use the option 'Station Number (Time Sensitive)",!,"Enter/Edit' to complete entry."
QUIT
+8 KILL DD,DO
+9 SET VACNT=VACNT+1
SET X=VACNT
SET DIC(0)="L"
SET DIC="^VA(389.9,"
DO FILE^DICN
if +Y<1
QUIT
WRITE ".."
+10 SET DA=+Y
SET DR=".02////2800101;.03////"_VADIV_";.04////"_VASITE
if VASITE=+VASITE&('$DATA(VAPRIM))
SET DR=DR_";.05////1;"
SET VAPRIM=1
SET DIE="^VA(389.9,"
+11 DO ^DIE
+12 KILL DIC,DIE,DA,DR
+13 QUIT
End DoDot:1
+14 QUIT
+15 ;
PRIM SET DIR(0)="N^.5:1.5:4"
SET DIR("A")="PRIMARY DIVISION"
+1 SET DIR("A",1)="If you know your stations PRIMARY DIVISION, you may"
+2 SET DIR("A",2)="enter it now. If not it can be entered at a later time."
+3 SET DIR("A",3)="However, it must be entered before the Billing software is used."
SET DIR("A",4)=" "
+4 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+5 IF +Y
SET VAPRIM=+Y
+6 QUIT
+7 ;
NEW ; -- add new entry to time sensitive file when adding a new division
+1 ; input: VASITE("NEW")=Y (after adding new entry)
+2 ; =internal number in 40.8^name^1
+3 ; -- called from DGPAR1
+4 ;
+5 NEW X,Y,DO,DD,DIC,DIE,DA,DR,DINUM
SET Y=VASITE("NEW")
+6 SET VASITE("OK")=0
+7 if 'Y!('$PIECE(Y,"^",3))
GOTO NEWQ
+8 ;not a new entry.
SET VADIV=+Y
IF $DATA(^VA(389.9,"C",VADIV))
GOTO NEWQ
+9 ;
+10 ;no station number or facility entered
SET VASITE=$PIECE($GET(^DG(40.8,VADIV,0)),U,2)
IF VASITE=""
SET VASITE=$PIECE($GET(^DIC(4,$PIECE(^DG(40.8,VADIV,0),U,7),99)),U)
IF VASITE=""
GOTO NEWQ
+11 ;
+12 IF VASITE'?3N.AN
SET $PIECE(VASITE("OK"),"^",2)="Division "_$PIECE(^DG(40.8,VADIV,0),"^")_" has station number in incorrect format."
GOTO NEWQ
+13 ;
ADD ; -add new entry
+1 ;
+2 LOCK +^VA(389.9,0):10
IF '$TEST
SET $PIECE(VASITE("OK"),"^",2)="Another user appears to be adding an entry"
GOTO NEWQ
+3 SET X=$PIECE($GET(^VA(389.9,0)),"^",3)
+4 LOCK -^VA(389.9,0)
+5 KILL DD,DO,DIC,DR
SET DLAYGO=389.9
SET DIC(0)="L"
SET DIC="^VA(389.9,"
+6 ;
+7 FOR X=X:1
if $DATA(VAIEN)
LOCK -^VA(389.9,VAIEN)
IF X>0
IF '$DATA(^VA(389.9,X))
SET VAIEN=X
LOCK +^VA(389.9,X,0)
IF $TEST
IF '$DATA(^VA(389.9,X,0))
SET DINUM=X
DO FILE^DICN
IF +Y>0
Begin DoDot:1
+8 SET VASITE("OK")=1
End DoDot:1
QUIT
+9 ;
EDIT ;
+1 SET DA=+Y
SET DR=".02////"_DT_";.03////"_VADIV_";.04////"_VASITE
SET DIE="^VA(389.9,"
+2 DO ^DIE
+3 ;
NEWQ ;
+1 IF '+VASITE("OK")
Begin DoDot:1
+2 WRITE !!?5,">>> An unsuccessful attempt was made to also add a new entry to"
+3 WRITE !?5," STATION NUMBER (TIME SENSITIVE) [#389.9] file for this division."
+4 IF $PIECE(VASITE("OK"),U,2)]""
WRITE !?5," *** ",$PIECE(VASITE("OK"),U,2)," ***"
+5 WRITE !!?5,">>> Please contact your IRM service after entering division data.",!,*7
End DoDot:1
+6 KILL VAIEN,VASITE,VADIV
+7 QUIT
