- 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