- LRCAPED ;SLC/DCM- MANUAL EDIT OF CAP AND WORKLOAD FILES ;8/28/89 12:07 ;
- ;;V~5.0~;LAB;;02/27/90 17:09
- EN ;
- W @IOF F I=0:0 S LRSTOP=0,LRSTOP=0,LRURG="",LRIN="" D NEW Q:LRSTOP
- K LRTDT,LRC,LRH1,LRC1,LRI,LRIN,LRTS,LRTSA,LRSB,LRM,LRCAP,LRX,LRA,LRSTOP,LRCAP,LRSTOP
- Q
- NEW K DIC W ! S DIC="^LAM(",DIC(0)="AEQM" D ^DIC I Y<1 S LRSTOP=1 Q
- S (LRCAP,DA)=+Y,LRM=$P(^LAM(+Y,0),"^",8),LRSB=$P(^LAM(+Y,0),"^",9)
- N W !,"Edit (S)PECIMEN COUNT, (R)EPEAT, (Q)C COUNT (X)REFERENCE OR (O)THER",!
- R ?15,"(S/R/Q/O/X): Q// ",X:DTIME S:'$T!(X="^") LRSTOP=1 Q:LRSTOP S LRX=$S(X="":"Q",1:$E(X))
- I X="?" W !!,"Choose the type of count to be edited.",!,"SPECIMEN COUNT- the count of actual patient specimens.",!,"REPEAT COUNT- repeats done for this procedure.",!,"QC COUNT- quality control count.",!,"OTHER - referral",! G N
- I "XOQRS"'[LRX!(LRSTOP) S LRSTOP=1 W:LRX'="^" !!?10,*7," ( ",LRX," ) IS NOT A VALID RESPONSE ",! Q
- TST K DIC S DIC="^LAB(60,",DIC(0)="ZAQEM" D ^DIC S:+Y<1 LRSTOP=1 Q:LRSTOP S LRTST=$S($L($P(^(.1),U)):$P(^(.1),U),1:$E($P(Y(0),U),1,20))
- S %DT="AERT",%DT("A")="Select LAB ARRIVAL DATE/TIME: " D ^%DT I Y<1 S LRSTOP=1 Q
- S LRTIM=+Y
- NUM R !,"Enter a positive or negative amount: 1// ",LRA:DTIME I '$T!(LRA="^") S LRSTOP=1 Q
- S:LRA="" LRA=1 I LRA'=+LRA!(LRA?.E1"."1N.N) W *7," ??",!?5,"Enter the amount to add or subtract from this CAP code.",!?5,"Entry must be a whole number." G NUM
- D S Q:LRSTOP D ENT^LRCAPED2 K DR,DIE,DIC Q:LRSTOP D ^LRCAPED1 K LRIN,LRURG,LRLOCAB,LRLOCTY,LRTSA,LRTS,DIC
- Q
- S I "XQ"[LRX S (LRTS,LRTSA)="LAB",LRIN=0,LRURG=9,LRLOCAB="LAB" Q
- K DIC S DIC="^SC(",DIC(0)="AQEMOZ" D ^DIC I Y<1 S (LRTS,LRTSA)="LAB",LRIN=0,LRLOCTY="Z" G S1
- S LRLOC=Y(0),LRLOCAB=$S($L($P(LRLOC,"^",2)):$P(LRLOC,"^",2),1:$P(LRLOC,"^")),LRLOCTY=$P(LRLOC,U,3),LRTS=$P(LRLOC,U,20) S:LRTS LRTS=$S($L($P(^DIC(45.7,LRTS,0),U,3)):$P(^(0),U,3),1:$P(LRLOC,"^",7))
- K DIC S DIC=45.7,DIC(0)="MAQEZ",DIC("B")=LRTS D ^DIC S:Y>0 LRTS=+Y,LRTSA=$S($L($P(Y(0),U,3)):$P(Y(0),U,3),1:$E($P(Y(0),U),1,5))
- S1 K DIC S LRURG=9 S:LRLOCTY="" LRLOCTY="Z" S LRIN=$S("WO"[LRLOCTY:1,1:0) I "SO"[LRX S DIC="^LAB(62.05,",DIC(0)="AEMQ" D ^DIC S LRURG=$S(Y>0:+Y,1:9) K DIC
- Q
- LRCAPED ;SLC/DCM- MANUAL EDIT OF CAP AND WORKLOAD FILES ;8/28/89 12:07 ;
- +1 ;;V~5.0~;LAB;;02/27/90 17:09
- EN ;
- +1 WRITE @IOF
- FOR I=0:0
- SET LRSTOP=0
- SET LRSTOP=0
- SET LRURG=""
- SET LRIN=""
- DO NEW
- IF LRSTOP
- QUIT
- +2 KILL LRTDT,LRC,LRH1,LRC1,LRI,LRIN,LRTS,LRTSA,LRSB,LRM,LRCAP,LRX,LRA,LRSTOP,LRCAP,LRSTOP
- +3 QUIT
- NEW KILL DIC
- WRITE !
- SET DIC="^LAM("
- SET DIC(0)="AEQM"
- DO ^DIC
- IF Y<1
- SET LRSTOP=1
- QUIT
- +1 SET (LRCAP,DA)=+Y
- SET LRM=$PIECE(^LAM(+Y,0),"^",8)
- SET LRSB=$PIECE(^LAM(+Y,0),"^",9)
- N WRITE !,"Edit (S)PECIMEN COUNT, (R)EPEAT, (Q)C COUNT (X)REFERENCE OR (O)THER",!
- +1 READ ?15,"(S/R/Q/O/X): Q// ",X:DTIME
- IF '$TEST!(X="^")
- SET LRSTOP=1
- IF LRSTOP
- QUIT
- SET LRX=$SELECT(X="":"Q",1:$EXTRACT(X))
- +2 IF X="?"
- WRITE !!,"Choose the type of count to be edited.",!,"SPECIMEN COUNT- the count of actual patient specimens.",!,"REPEAT COUNT- repeats done for this procedure.",!,"QC COUNT- quality control count.",!,"OTHER - referral",!
- GOTO N
- +3 IF "XOQRS"'[LRX!(LRSTOP)
- SET LRSTOP=1
- IF LRX'="^"
- WRITE !!?10,*7," ( ",LRX," ) IS NOT A VALID RESPONSE ",!
- QUIT
- TST KILL DIC
- SET DIC="^LAB(60,"
- SET DIC(0)="ZAQEM"
- DO ^DIC
- IF +Y<1
- SET LRSTOP=1
- IF LRSTOP
- QUIT
- SET LRTST=$SELECT($LENGTH($PIECE(^(.1),U)):$PIECE(^(.1),U),1:$EXTRACT($PIECE(Y(0),U),1,20))
- +1 SET %DT="AERT"
- SET %DT("A")="Select LAB ARRIVAL DATE/TIME: "
- DO ^%DT
- IF Y<1
- SET LRSTOP=1
- QUIT
- +2 SET LRTIM=+Y
- NUM READ !,"Enter a positive or negative amount: 1// ",LRA:DTIME
- IF '$TEST!(LRA="^")
- SET LRSTOP=1
- QUIT
- +1 IF LRA=""
- SET LRA=1
- IF LRA'=+LRA!(LRA?.E1"."1N.N)
- WRITE *7," ??",!?5,"Enter the amount to add or subtract from this CAP code.",!?5,"Entry must be a whole number."
- GOTO NUM
- +2 DO S
- IF LRSTOP
- QUIT
- DO ENT^LRCAPED2
- KILL DR,DIE,DIC
- IF LRSTOP
- QUIT
- DO ^LRCAPED1
- KILL LRIN,LRURG,LRLOCAB,LRLOCTY,LRTSA,LRTS,DIC
- +3 QUIT
- S IF "XQ"[LRX
- SET (LRTS,LRTSA)="LAB"
- SET LRIN=0
- SET LRURG=9
- SET LRLOCAB="LAB"
- QUIT
- +1 KILL DIC
- SET DIC="^SC("
- SET DIC(0)="AQEMOZ"
- DO ^DIC
- IF Y<1
- SET (LRTS,LRTSA)="LAB"
- SET LRIN=0
- SET LRLOCTY="Z"
- GOTO S1
- +2 SET LRLOC=Y(0)
- SET LRLOCAB=$SELECT($LENGTH($PIECE(LRLOC,"^",2)):$PIECE(LRLOC,"^",2),1:$PIECE(LRLOC,"^"))
- SET LRLOCTY=$PIECE(LRLOC,U,3)
- SET LRTS=$PIECE(LRLOC,U,20)
- IF LRTS
- SET LRTS=$SELECT($LENGTH($PIECE(^DIC(45.7,LRTS,0),U,3)):$PIECE(^(0),U,3),1:$PIECE(LRLOC,"^",7))
- +3 KILL DIC
- SET DIC=45.7
- SET DIC(0)="MAQEZ"
- SET DIC("B")=LRTS
- DO ^DIC
- IF Y>0
- SET LRTS=+Y
- SET LRTSA=$SELECT($LENGTH($PIECE(Y(0),U,3)):$PIECE(Y(0),U,3),1:$EXTRACT($PIECE(Y(0),U),1,5))
- S1 KILL DIC
- SET LRURG=9
- IF LRLOCTY=""
- SET LRLOCTY="Z"
- SET LRIN=$SELECT("WO"[LRLOCTY:1,1:0)
- IF "SO"[LRX
- SET DIC="^LAB(62.05,"
- SET DIC(0)="AEMQ"
- DO ^DIC
- SET LRURG=$SELECT(Y>0:+Y,1:9)
- KILL DIC
- +1 QUIT
