| 1 | QAOSCREE ;HISC/JES,DAD-ADD OR CHANGE VAMC SPECIFIC OCCURRENCE SCREENS ;2/4/93 08:11
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | ;THIS ROUTINE PROVIDES THE OPTION TO ADD VAMC-SPECIFIC SCREENS IN THE
|
|---|
| 4 | ;RANGE OF 201 TO 999.99, AND ALSO TO ENTER CORRESPONDING EXCEPTIONS
|
|---|
| 5 | EDSCREE ;
|
|---|
| 6 | R !!,"Select SCREEN: ",X:DTIME S:'$T X="^" G:(X="")!(X="^") EXIT
|
|---|
| 7 | I X?1.N.NP,((X<101)!(X>999.99)!($P($G(^QA(741.1,+X,0)),"^",4)="N")) D G EDSCREE
|
|---|
| 8 | . W " ??",*7,!
|
|---|
| 9 | . W !?5,"Answer with a number from 101 to 999.99."
|
|---|
| 10 | . W !?5,"You may not select 'NATIONAL' screens."
|
|---|
| 11 | . Q
|
|---|
| 12 | S (DIC,DIE)="^QA(741.1,",DIC("A")="Select SCREEN: ",DIC(0)="ELMQZ"
|
|---|
| 13 | S DIC("S")="I $P(^(0),""^"",4)'=""N""",(DIDEL,DLAYGO)=741.1
|
|---|
| 14 | D ^DIC K DIC("S") G:+Y=-1 EDSCREE S (QAPOINT,DA)=+Y
|
|---|
| 15 | S DR=".01;1T;2T;100//LOCAL" D ^DIE
|
|---|
| 16 | D:'$D(DA) KILLXCPT G:('$D(DA))!($D(Y)) EDSCREE
|
|---|
| 17 | I $D(^QA(741.1,QAPOINT,0))#2,$P(^(0),"^",4)'>0 D EDEXCPT
|
|---|
| 18 | G EDSCREE
|
|---|
| 19 | EDEXCPT ;
|
|---|
| 20 | S (DIC,DIE)="^QA(741.5,",DIC("A")="Select REASON FOR EXCEPTION: "
|
|---|
| 21 | S DIC(0)="AELMQ",DIC("DR")="",(DIDEL,DLAYGO)=741.5
|
|---|
| 22 | S DIC("S")="I $P(^QA(741.5,+Y,0),""^"",2)=QAPOINT"
|
|---|
| 23 | D ^DIC K DIC("DR"),DIC("S") Q:+Y=-1
|
|---|
| 24 | S DA=+Y,DR="1///`"_QAPOINT_";.01;.02;100//ACTIVE"
|
|---|
| 25 | D ^DIE Q:$D(Y)
|
|---|
| 26 | G EDEXCPT
|
|---|
| 27 | KILLXCPT ;
|
|---|
| 28 | S DIK="^QA(741.5,"
|
|---|
| 29 | F QADA=0:0 S QADA=$O(^QA(741.5,"C",QAPOINT,QADA)) Q:QADA'>0 S DA=QADA D ^DIK
|
|---|
| 30 | S DIK="^QA(741.4," F QADA(0)=0:0 S QADA(0)=$O(^QA(741.4,"AC",QAPOINT,QADA(0))) Q:QADA(0)'>0 F QADA=0:0 S QADA=$O(^QA(741.4,"AC",QAPOINT,QADA(0),QADA)) Q:QADA'>0 S DA=QADA D ^DIK
|
|---|
| 31 | K DA,DIK,QADA
|
|---|
| 32 | Q
|
|---|
| 33 | EXIT ;
|
|---|
| 34 | K DA,DIC,DIE,DIK,DR,DIDEL,DLAYGO,QAPOINT,QADA,X,Y
|
|---|
| 35 | K %,%H,C,D0,DI,DQ,I,Y,Z,DG,DK,DL
|
|---|
| 36 | Q
|
|---|
