- LABCX7L ; IHS/DIR/FJE - ; [ 05/30/2003 4:00 PM ]
- ;;5.2;LA;**1016**;MAY 27, 2003
- DOC ;Displays the CX7 download list for the CX7.
- INIT S A=0,CT=0 F I=1:1 S A=$O(^LAZ(A)) Q:A=""!(A["ZZZ") S CT=CT+1
- I CT=0 W !!,"There are NO entries in the CX7 download list." G EXIT
- I CT=1 W !!,"There is 1 entry in the CX7 download list." D ONE S ID=A D DELETE G EXIT
- W !!,"There are ",CT," entries in the CX7 download list."
- R !!,"Do you want a list? Y// ",ANS:DTIME G:'$T EXIT W !
- I ANS["N"!(ANS["n") D LOOKUP G EXIT
- LIST ;List all entries of ^LAZ(A)
- S (A,LC)=0 K IOP D ^%ZIS Q:POP U IO I IO'=IO(0) W @IOF S Y=DT X ^DD("DD") W !!,?21,"CX7 DOWNLOAD LIST, PRINTED: ",Y,!!
- A S A=$O(^LAZ(A)) I A=""!(A["ZZZ") D ^%ZISC G LOOKUP
- I IO=IO(0) S LC=LC+1 I LC>21 S LC=0 R !!,"Press any key to continue ",*AN:DTIME I AN=94 S A=0 D LOOKUP G EXIT
- S DATA=^LAZ(A,0)
- W !,?7,$S($P(DATA,",",7)="ST":"STAT",1:""),?14,A," ",$E($P(DATA,",",16),4,12)," ",$P(DATA,",",13,14) ;***JPC ADDED STAT TO LIST
- G A
- LOOKUP ;Look up one particular Sample Id
- R !!,"Enter the 11 digit Sample Id: ",ID:DTIME I '$T!(ID="") G EXIT
- ;I ID["?" W ! G INIT
- I ID["?" W !,"Enter Sample ID (eg. CX704230162) or LOOP",! G INIT ;IHS/ANMC/CLS 07/12/96
- I ID="LOOP" S A=0 F I=1:1 S A=$O(^LAZ(A)) G:A=""!(A["ZZZ")!(ANS="^") INIT W !!,A," will be deleted" S ID=A D KILL
- ;I $L(ID)<11 S ID=$E(ID_" ",1,11) ;***JPC - NO TRAILING SPACES IN KEY
- I '$D(^LAZ(ID)) W !,?14,ID," is NOT in the download list." G LOOKUP
- S DATA=^LAZ(ID,0)
- W !,?7,$S($P(DATA,",",7)="ST":"STAT",1:""),?14,ID," ",$E($P(DATA,",",16),4,12)," ",$P(DATA,",",13,14) ;***JPC ADDED STAT TO LIST
- D DELETE G LOOKUP
- DELETE ;Allow the user to delete the ^LAZ(ID) entry
- R !,?14,"Do you want to delete this entry? N// ",ANS:DTIME Q:'$T
- I ANS["Y"!(ANS["y") D KILL Q
- E W " NO CHANGE."
- Q
- KILL ;Kills ^LAZ(ID)
- W *7,!,?14,"ARE YOU SURE? N// " R ANS:DTIME Q:'$T
- I ANS["Y"!(ANS["y") K ^LAZ(ID) W " ",ID," HAS BEEN DELETED!!!"
- E W " NO CHANGE."
- Q
- ONE ;automatically list the 1 entry
- S A=0,A=$O(^LAZ(A)) S DATA=$G(^(A)) W !!,?7,$S($P(DATA,",",7)="ST":"STAT",1:""),?14,A," ",$E($P(DATA,",",16),4,12)," ",$P(DATA,",",13,14) ;***JPC - PRINT ENTRY AS THE OTHERS DO.
- ;JPC NOTE - START A AT BEGINNING TO INSURE GETTING CORRECT KEY. WITHOUT "S A=0", IF THERE WAS "ZZZ" ERROR ENTRY, $O WOULD PRODUCE THE "ZZZERROR" KEY AND DELETE ALL OF THE STANDARD ERROR MESSAGES
- Q
- EXIT K A,AN,ANS,CT,DATA,I,ID,LC,Y Q ;Kills variables and final exit point.
- LABCX7L ; IHS/DIR/FJE - ; [ 05/30/2003 4:00 PM ]
- +1 ;;5.2;LA;**1016**;MAY 27, 2003
- DOC ;Displays the CX7 download list for the CX7.
- INIT SET A=0
- SET CT=0
- FOR I=1:1
- SET A=$ORDER(^LAZ(A))
- IF A=""!(A["ZZZ")
- QUIT
- SET CT=CT+1
- +1 IF CT=0
- WRITE !!,"There are NO entries in the CX7 download list."
- GOTO EXIT
- +2 IF CT=1
- WRITE !!,"There is 1 entry in the CX7 download list."
- DO ONE
- SET ID=A
- DO DELETE
- GOTO EXIT
- +3 WRITE !!,"There are ",CT," entries in the CX7 download list."
- +4 READ !!,"Do you want a list? Y// ",ANS:DTIME
- IF '$TEST
- GOTO EXIT
- WRITE !
- +5 IF ANS["N"!(ANS["n")
- DO LOOKUP
- GOTO EXIT
- LIST ;List all entries of ^LAZ(A)
- +1 SET (A,LC)=0
- KILL IOP
- DO ^%ZIS
- IF POP
- QUIT
- USE IO
- IF IO'=IO(0)
- WRITE @IOF
- SET Y=DT
- XECUTE ^DD("DD")
- WRITE !!,?21,"CX7 DOWNLOAD LIST, PRINTED: ",Y,!!
- A SET A=$ORDER(^LAZ(A))
- IF A=""!(A["ZZZ")
- DO ^%ZISC
- GOTO LOOKUP
- +1 IF IO=IO(0)
- SET LC=LC+1
- IF LC>21
- SET LC=0
- READ !!,"Press any key to continue ",*AN:DTIME
- IF AN=94
- SET A=0
- DO LOOKUP
- GOTO EXIT
- +2 SET DATA=^LAZ(A,0)
- +3 ;***JPC ADDED STAT TO LIST
- WRITE !,?7,$SELECT($PIECE(DATA,",",7)="ST":"STAT",1:""),?14,A," ",$EXTRACT($PIECE(DATA,",",16),4,12)," ",$PIECE(DATA,",",13,14)
- +4 GOTO A
- LOOKUP ;Look up one particular Sample Id
- +1 READ !!,"Enter the 11 digit Sample Id: ",ID:DTIME
- IF '$TEST!(ID="")
- GOTO EXIT
- +2 ;I ID["?" W ! G INIT
- +3 ;IHS/ANMC/CLS 07/12/96
- IF ID["?"
- WRITE !,"Enter Sample ID (eg. CX704230162) or LOOP",!
- GOTO INIT
- +4 IF ID="LOOP"
- SET A=0
- FOR I=1:1
- SET A=$ORDER(^LAZ(A))
- IF A=""!(A["ZZZ")!(ANS="^")
- GOTO INIT
- WRITE !!,A," will be deleted"
- SET ID=A
- DO KILL
- +5 ;I $L(ID)<11 S ID=$E(ID_" ",1,11) ;***JPC - NO TRAILING SPACES IN KEY
- +6 IF '$DATA(^LAZ(ID))
- WRITE !,?14,ID," is NOT in the download list."
- GOTO LOOKUP
- +7 SET DATA=^LAZ(ID,0)
- +8 ;***JPC ADDED STAT TO LIST
- WRITE !,?7,$SELECT($PIECE(DATA,",",7)="ST":"STAT",1:""),?14,ID," ",$EXTRACT($PIECE(DATA,",",16),4,12)," ",$PIECE(DATA,",",13,14)
- +9 DO DELETE
- GOTO LOOKUP
- DELETE ;Allow the user to delete the ^LAZ(ID) entry
- +1 READ !,?14,"Do you want to delete this entry? N// ",ANS:DTIME
- IF '$TEST
- QUIT
- +2 IF ANS["Y"!(ANS["y")
- DO KILL
- QUIT
- +3 IF '$TEST
- WRITE " NO CHANGE."
- +4 QUIT
- KILL ;Kills ^LAZ(ID)
- +1 WRITE *7,!,?14,"ARE YOU SURE? N// "
- READ ANS:DTIME
- IF '$TEST
- QUIT
- +2 IF ANS["Y"!(ANS["y")
- KILL ^LAZ(ID)
- WRITE " ",ID," HAS BEEN DELETED!!!"
- +3 IF '$TEST
- WRITE " NO CHANGE."
- +4 QUIT
- ONE ;automatically list the 1 entry
- +1 ;***JPC - PRINT ENTRY AS THE OTHERS DO.
- SET A=0
- SET A=$ORDER(^LAZ(A))
- SET DATA=$GET(^(A))
- WRITE !!,?7,$SELECT($PIECE(DATA,",",7)="ST":"STAT",1:""),?14,A," ",$EXTRACT($PIECE(DATA,",",16),4,12)," ",$PIECE(DATA,",",13,14)
- +2 ;JPC NOTE - START A AT BEGINNING TO INSURE GETTING CORRECT KEY. WITHOUT "S A=0", IF THERE WAS "ZZZ" ERROR ENTRY, $O WOULD PRODUCE THE "ZZZERROR" KEY AND DELETE ALL OF THE STANDARD ERROR MESSAGES
- +3 QUIT
- EXIT ;Kills variables and final exit point.
- KILL A,AN,ANS,CT,DATA,I,ID,LC,Y
- QUIT
