- 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 Feb 19, 2025@00:29:58 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