ABSPOS2A ; IHS/FCS/DRS - continuation of ABSPOS2 ;
;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
Q
JOBS ; protocol ABSP P2 TMIT JOBS
N WHAT S WHAT="Maximum number of transmitter-receiver jobs: "
N PMT S PMT=WHAT
S DEF=$$MAXJOBS^ABSPOSQ3
N OPT,MIN,MAX,DEC S OPT=1,MIN=1,MAX=10,DEC=0
N ANS S ANS=$$NUMERIC^ABSPOSU2(PMT,DEF,OPT,MIN,MAX,DEC)
I ANS?1N.N D MAXJOBS^ABSPOSQ3(ANS)
S ANS=$$MAXJOBS^ABSPOSQ3
W !,WHAT," = ",ANS,!
D ANY
S VALMBCK=""
Q
WOW ; protocol ABSP P2 WINNOW ; Winnow or Erase data or Big erase data
; This is going to be put on the manager menu proper, instead.
; Re-development is underway in ABSPOSK*
W !,"This option is temporarily disabled.",! D ANY S VALMBCK="R" Q
ZERO ; protocol ABSP P2 ZERO ; clearing stats
N PMT S PMT="Clear your local copy of stats (L) or clear the permanent copy (P)? "
N DEF S DEF="L" ; default: my local copy
N OPT S OPT=1 ; answer is optional
N DISP S DISP="N" ; no display (it's in the prompt)
N CHC S CHC="L:my Local copy;P:the Permanent copy"
N ANS S ANS=$$SET^ABSPOSU3(PMT,DEF,OPT,DISP,CHC)
; ANS = "" or -1 or ^ or ^^ or L or P
I ANS="L" D
.W !,"Clearing local stats - in testing - copying CURR to BASE:",!
.D DIFF^ABSPOS2 ; compute DIFF=CURR-BASE one last time
.D ZLOCAL ; now we copy CURR into BASE; next time DIFFs will be 0
E I ANS="P" D
.W !,"Clear the permanent stats? " I $$SURE'=1 Q
.D ZPERM
.D FETCHES^ABSPOS2(0) ; fetch all these zeroes into BASE(*)
E D ; nothing if "" or -1 or ^ or ^^
.W !,"Nothing changed.",!
D ANY ; press any key
; then UPD calls UPDATE(1) calls UPD1 calls FETCHES(1) and DIFF,
; which will set lots of CHG nodes = 0, and display should show that
D UPD^ABSPOS2
S VALMBCK=""
Q
ZLOCAL W !,"Clearing local stats - in testing",!
W "we copy CURR(*) to BASE(*)",!
K BASE M BASE=CURR
Q
ZPERM W !,"Clearing permanent stats - in testing",!
W "We do it by setting many fields in file 9002313.58 to zero",!
N FILE S FILE=9002313.58
L +^ABSPECX("S"):300 I '$T W "LOCK failed",! Q
;W "Idea: save old copies in higher-numbered nodes.",!
D
.N I F I=3,4 D
. . N N S N=$P(^ABSPECX("S",0),U,I)+1
. . S $P(^ABSPECX("S",0),U,I)=N
. N N S N=$P(^ABSPECX("S",0),U,3)
.M ^ABSPECX("S",N)=^ABSPECX("S",1)
.S $P(^ABSPECX("S",N,0),U)=N ; fix up the .01 field
.N DIK,DA S DIK="^ABSPECX(""S"",",DA=N D IX^DIK ; trivial indexing
W "Now we zero out lots of fields: " H 1
N FIELD S FIELD=.01
F S FIELD=$O(^DD(FILE,FIELD)) Q:'FIELD D
.N VALUE
.I FIELD=2 D ; date/time last cleared
..N %,%H,%I,X D NOW^%DTC S VALUE=%
.E S VALUE=0
.N DIE,DA,DR S DIE=FILE,DA=1,DR=FIELD_"////"_VALUE D ^DIE
W "Done",!
L -^ABSPECX("S")
Q
TMR ; Protocol ABSP P2 TRANSMITTER ; Transmitter on/off
N CURR S CURR=$$SHUTDOWN^ABSPOSQ3 ; currently, the shutdown flag is:
D TMNOW
N PMT,DEF,OPT,ANS S PMT="Do you wish to "_$S(CURR:"en",1:"dis")
S PMT=PMT_"able the transmitter-receiver"
S DEF="N"
S OPT=1
S ANS=$$YESNO^ABSPOSU3(PMT,DEF,OPT)
I ANS=1 I $$SHUTDOWN^ABSPOSQ3('CURR)
S CURR=$$SHUTDOWN^ABSPOSQ3
D TMNOW,ANY
S VALMBCK=""
Q
TMNOW W !,"The transmitter-receiver is currently "
W $S(CURR:"dis",1:"en"),"abled.",! Q
POK ; protocol ABSP P2 POKE ; Poke the queues
W !,"Poke the queues? " I $$SURE=1 D POKE^ABSPOS2D
S VALMBCK=""
Q
SURE(DEF) N SURE
S PMT="Are you sure"
I '$D(DEF) S DEF="Y"
N OPT S OPT=1 ; answer is optional
N ANS S ANS=$$YESNO^ABSPOSU3(PMT,DEF,OPT)
Q ANS ; 1 or 0 or -1 or ^ or ^^ or null
ANY ;EP - from ABSPOS6D,ABSPOS6K
W:$X ! D PRESSANY^ABSPOSU5() Q ; Press any key
ABSPOS2A ; IHS/FCS/DRS - continuation of ABSPOS2 ;
+1 ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
+2 QUIT
JOBS ; protocol ABSP P2 TMIT JOBS
+1 NEW WHAT
SET WHAT="Maximum number of transmitter-receiver jobs: "
+2 NEW PMT
SET PMT=WHAT
+3 SET DEF=$$MAXJOBS^ABSPOSQ3
+4 NEW OPT,MIN,MAX,DEC
SET OPT=1
SET MIN=1
SET MAX=10
SET DEC=0
+5 NEW ANS
SET ANS=$$NUMERIC^ABSPOSU2(PMT,DEF,OPT,MIN,MAX,DEC)
+6 IF ANS?1N.N
DO MAXJOBS^ABSPOSQ3(ANS)
+7 SET ANS=$$MAXJOBS^ABSPOSQ3
+8 WRITE !,WHAT," = ",ANS,!
+9 DO ANY
+10 SET VALMBCK=""
+11 QUIT
WOW ; protocol ABSP P2 WINNOW ; Winnow or Erase data or Big erase data
+1 ; This is going to be put on the manager menu proper, instead.
+2 ; Re-development is underway in ABSPOSK*
+3 WRITE !,"This option is temporarily disabled.",!
DO ANY
SET VALMBCK="R"
QUIT
ZERO ; protocol ABSP P2 ZERO ; clearing stats
+1 NEW PMT
SET PMT="Clear your local copy of stats (L) or clear the permanent copy (P)? "
+2 ; default: my local copy
NEW DEF
SET DEF="L"
+3 ; answer is optional
NEW OPT
SET OPT=1
+4 ; no display (it's in the prompt)
NEW DISP
SET DISP="N"
+5 NEW CHC
SET CHC="L:my Local copy;P:the Permanent copy"
+6 NEW ANS
SET ANS=$$SET^ABSPOSU3(PMT,DEF,OPT,DISP,CHC)
+7 ; ANS = "" or -1 or ^ or ^^ or L or P
+8 IF ANS="L"
Begin DoDot:1
+9 WRITE !,"Clearing local stats - in testing - copying CURR to BASE:",!
+10 ; compute DIFF=CURR-BASE one last time
DO DIFF^ABSPOS2
+11 ; now we copy CURR into BASE; next time DIFFs will be 0
DO ZLOCAL
End DoDot:1
+12 IF '$TEST
IF ANS="P"
Begin DoDot:1
+13 WRITE !,"Clear the permanent stats? "
IF $$SURE'=1
QUIT
+14 DO ZPERM
+15 ; fetch all these zeroes into BASE(*)
DO FETCHES^ABSPOS2(0)
End DoDot:1
+16 ; nothing if "" or -1 or ^ or ^^
IF '$TEST
Begin DoDot:1
+17 WRITE !,"Nothing changed.",!
End DoDot:1
+18 ; press any key
DO ANY
+19 ; then UPD calls UPDATE(1) calls UPD1 calls FETCHES(1) and DIFF,
+20 ; which will set lots of CHG nodes = 0, and display should show that
+21 DO UPD^ABSPOS2
+22 SET VALMBCK=""
+23 QUIT
ZLOCAL WRITE !,"Clearing local stats - in testing",!
+1 WRITE "we copy CURR(*) to BASE(*)",!
+2 KILL BASE
MERGE BASE=CURR
+3 QUIT
ZPERM WRITE !,"Clearing permanent stats - in testing",!
+1 WRITE "We do it by setting many fields in file 9002313.58 to zero",!
+2 NEW FILE
SET FILE=9002313.58
+3 LOCK +^ABSPECX("S"):300
IF '$TEST
WRITE "LOCK failed",!
QUIT
+4 ;W "Idea: save old copies in higher-numbered nodes.",!
+5 Begin DoDot:1
+6 NEW I
FOR I=3,4
Begin DoDot:2
+7 NEW N
SET N=$PIECE(^ABSPECX("S",0),U,I)+1
+8 SET $PIECE(^ABSPECX("S",0),U,I)=N
End DoDot:2
+9 NEW N
SET N=$PIECE(^ABSPECX("S",0),U,3)
+10 MERGE ^ABSPECX("S",N)=^ABSPECX("S",1)
+11 ; fix up the .01 field
SET $PIECE(^ABSPECX("S",N,0),U)=N
+12 ; trivial indexing
NEW DIK,DA
SET DIK="^ABSPECX(""S"","
SET DA=N
DO IX^DIK
End DoDot:1
+13 WRITE "Now we zero out lots of fields: "
HANG 1
+14 NEW FIELD
SET FIELD=.01
+15 FOR
SET FIELD=$ORDER(^DD(FILE,FIELD))
IF 'FIELD
QUIT
Begin DoDot:1
+16 NEW VALUE
+17 ; date/time last cleared
IF FIELD=2
Begin DoDot:2
+18 NEW %,%H,%I,X
DO NOW^%DTC
SET VALUE=%
End DoDot:2
+19 IF '$TEST
SET VALUE=0
+20 NEW DIE,DA,DR
SET DIE=FILE
SET DA=1
SET DR=FIELD_"////"_VALUE
DO ^DIE
End DoDot:1
+21 WRITE "Done",!
+22 LOCK -^ABSPECX("S")
+23 QUIT
TMR ; Protocol ABSP P2 TRANSMITTER ; Transmitter on/off
+1 ; currently, the shutdown flag is:
NEW CURR
SET CURR=$$SHUTDOWN^ABSPOSQ3
+2 DO TMNOW
+3 NEW PMT,DEF,OPT,ANS
SET PMT="Do you wish to "_$SELECT(CURR:"en",1:"dis")
+4 SET PMT=PMT_"able the transmitter-receiver"
+5 SET DEF="N"
+6 SET OPT=1
+7 SET ANS=$$YESNO^ABSPOSU3(PMT,DEF,OPT)
+8 IF ANS=1
IF $$SHUTDOWN^ABSPOSQ3('CURR)
+9 SET CURR=$$SHUTDOWN^ABSPOSQ3
+10 DO TMNOW
DO ANY
+11 SET VALMBCK=""
+12 QUIT
TMNOW WRITE !,"The transmitter-receiver is currently "
+1 WRITE $SELECT(CURR:"dis",1:"en"),"abled.",!
QUIT
POK ; protocol ABSP P2 POKE ; Poke the queues
+1 WRITE !,"Poke the queues? "
IF $$SURE=1
DO POKE^ABSPOS2D
+2 SET VALMBCK=""
+3 QUIT
SURE(DEF) NEW SURE
+1 SET PMT="Are you sure"
+2 IF '$DATA(DEF)
SET DEF="Y"
+3 ; answer is optional
NEW OPT
SET OPT=1
+4 NEW ANS
SET ANS=$$YESNO^ABSPOSU3(PMT,DEF,OPT)
+5 ; 1 or 0 or -1 or ^ or ^^ or null
QUIT ANS
ANY ;EP - from ABSPOS6D,ABSPOS6K
+1 ; Press any key
IF $X
WRITE !
DO PRESSANY^ABSPOSU5()
QUIT
