ABSPOS6I ; IHS/FCS/DRS - Data Entry & Status Disp ;
;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
;
; ALL writes of screen lines as follows:
; IF $$VISIBLE(line) DO WRITE^VALM10(line)
; When approp., set NODISPLY=true and $$VISIBLE returns false
Q
; DISPDBG: are we debugging the display?
DISPDBG() Q $P($G(^ABSP(9002313.99,1,"ABSPOS6*")),U)
DISPHIST(MSG,HANG) ; DEBUGGING - to record history and pause
Q:'$$DISPDBG
I '$D(HANG) S HANG=1
D DISPHIST^ABSPOS6H(MSG,HANG)
Q
UPDATE(COUNTER) ;EP - from ABSPOS6A
; with COUNTER = a count down, -1 for indefinite repeat
N CHGCOUNT S CHGCOUNT=0
N STOP F D Q:$G(STOP)
.D UPD1
.S COUNTER=COUNTER-1 I 'COUNTER S STOP=1 Q
.I '$G(NODISPLY) D
..D MSG^VALM10("In continuous update mode: press Q to Quit")
..N X ;R X#1:^TMP("ABSPOS",$J,"FREQ") D MSG^VALM10(" ")
..;Try doing this single-character read with ^XGKB
..;I $D(^TMP("XGKEY",$J)) ; possible interference
..S X=$$READ^XGKB(1,^TMP("ABSPOS",$J,"FREQ"))
..;I X]"","Qq^^"[X S STOP=1
..I '$G(DTOUT),X]"","Qq^^"[X S STOP=1
..N Y F R Y:0 Q:'$T ; clean out typeahead (like mistaken arrow keys)
Q
UPD1 ; one update cycle
N NOW,PAT,RXI,T,CHG,LAST,OLDEST,ONEPAT D
.N %,%H,%I,X D NOW^%DTC S NOW=%
S ONEPAT=^TMP("ABSPOS",$J,"PATIENT")
I ONEPAT D
.S T=^TMP("ABSPOS",$J,"PATIENT TIME")
.S CHG=$$SORT^ABSPOSUA(0,ONEPAT,T,1)
E D
.S T=^TMP("ABSPOS",$J,"LAST UPDATE") ; absolute time on 2nd & subseq
.I T="" S T=^TMP("ABSPOS",$J,"TIME") ; delta time on 1st call
.S ^TMP("ABSPOS",$J,"LAST UPDATE")=NOW ; remember the time you did this
.S CHG=$$SORT^ABSPOSUA(^TMP("ABSPOS",$J,"USER"),,T) ; get changes
S OLDEST=$$TADD^ABSPOSUD(NOW,-^TMP("ABSPOS",$J,"TIME"))
;
; Deal with dismissals
;
S PAT="" F S PAT=$O(@DISMISS@(PAT)) Q:PAT="" D
.I PAT'?1"*".E,'ONEPAT Q
.I @DISMISS@(PAT)<OLDEST K @DISMISS@(PAT) Q ; dismissal order expired
.I '$D(@CHG@(PAT)) Q ; no changes for this patient
.S RXI="" F S RXI=$O(@DISMISS@(PAT,RXI)) Q:RXI="" D
..I @DISMISS@(PAT,RXI)<OLDEST K @DISMISS@(PAT,RXI) Q ; order expired
..I $D(@CHG@(PAT,RXI)) D ; a change has occurred in a dismissed RX
...K @CHG@(PAT,RXI) ; so ignore the change
...I $O(@CHG@(PAT,""))="" K @CHG@(PAT) ; and maybe patient is empty
S CHGCOUNT=$G(CHGCOUNT)+1
I $$DISPDBG D
. D DISPHIST("CHGCOUNT="_CHGCOUNT_" computed with T="_T)
. K ^TMP("ABSPOS",$J,"CHG",CHGCOUNT)
. M ^TMP("ABSPOS",$J,"CHG",CHGCOUNT)=@CHG
; And you have DISP,DISPLINE,DISPIDX already set up from caller
;
; Now deal with any surviving changes
;
S PAT="" F S PAT=$O(@CHG@(PAT)) Q:PAT="" D UPDPAT
;
; And finally, weed out any which haven't seen any changes
; in the last ^TMP("ABSPOS",$J,"TIME") time
;
I 'ONEPAT S PAT="" F S PAT=$O(@DISP@(PAT)) Q:PAT="" D
.S X=@DISP@(PAT),LAST=$P(X,U,3) ; last update for this patient
.I LAST<OLDEST,$P(X,U,4)*100=$P(X,U,2) D ; old & complete
..D DISPHIST("Deleting "_PAT_" "_LAST_"<"_OLDEST)
..N NLINES S NLINES=$P(X,U,4)+1 ; how many line this one occupies
..D SHIFTUP($P(X,U)+NLINES,$P(X,U)) ;
..K @DISP@(PAT)
Q
UPDPAT ; Update for a given @CHG@(PAT)
;I $P($G(^ABSP(9002313.99,1,"ABSPOS6*")),U,2) S $ZT="ERR^ZU"
N NEWPAT,RXI,I
N PATCHG S PATCHG=0 ; "patient changed", set to 1 if so
D DISPHIST("UPDPAT for PAT="_PAT,0)
;
I $D(@DISP@(PAT)) S NEWPAT=0 G UPD2 ; nope, we already have them
;
D DISPHIST("New patient not yet on our list",0)
S (NEWPAT,PATCHG)=1 ; set "new patient" flag
N NPRESC S NPRESC=@CHG@(PAT) ; how many prescriptions
N NLINES S NLINES=NPRESC+1 ; plus one more line for the patient
I VALMCNT+NLINES>^TMP("ABSPOS",$J,"MAX LINES") Q ; overflow
N PATNEXT S PATNEXT=$O(@DISP@(PAT))
I PATNEXT="" D ; the new patient and prescriptions go at end
.S LINE=@DISPLINE+1 ; this is the new line number
.S (VALMCNT,@DISPLINE)=@DISPLINE+NLINES ; update count of total lines
.D DISPHIST("Goes at end, on line #"_LINE,0)
E D ; the new patient pushes the next one downward
.D DISPHIST("Pushes existing ones at line "_LINE_" down "_NLINES,1)
.S LINE=$P(@DISP@(PATNEXT),U)
.D SHIFTDN(LINE,NLINES)
;
; common handling for new patient, whether at end or not
;
S @DISP@(PAT)=LINE_U_U_U_NPRESC
S @DISPLINE@(LINE)=PAT_U ; remember who's stored here
;
; Init for each prescription that came with this new patient
;
S RXI="" ; should always get @CHG@(PAT) iterations, right?
F I=1:1:@CHG@(PAT) S RXI=$O(@CHG@(PAT,"RXI",RXI)) Q:RXI="" D
.S @DISP@(PAT,RXI)=(LINE+I)_U_U
.S @DISPLINE@(LINE+I)=PAT_U_RXI
;
; and fall through to treat the rest of it same as existing patient
G UPD3
UPD2 ;
; Patient was already in our list, but maybe there are
; new prescriptions for which we must make room
;
S RXI="" F I=1:1:@CHG@(PAT) S RXI=$O(@CHG@(PAT,"RXI",RXI)) D
.Q:$D(@DISP@(PAT,RXI)) ; prescription already has a spot
.I VALMCNT+1>^TMP("ABSPOS",$J,"MAX LINES") Q ; overflow
.N I ; protect index
.D DISPHIST("New prescription "_RXI_" for "_PAT,0)
.;
.; a new prescription for the already-existent patient
.; assign a line for it and shift everything else down
.;
.S PATCHG=1 ; flag: "patient info has changed"
.N ADDATEND
.N RXINEXT S RXINEXT=$O(@DISP@(PAT,RXI))
.I RXINEXT S LINE=$P(@DISP@(PAT,RXINEXT),U),ADDATEND=0
.E D ; prescription comes at end of this patient's stuff
..N PATNEXT S PATNEXT=$O(@DISP@(PAT))
..I PATNEXT="" S ADDATEND=1
..E S LINE=$P(@DISP@(PATNEXT),U),ADDATEND=0
.I ADDATEND D ; adding at end, nothing needs to be shifted down
..S LINE=@DISPLINE+1,(VALMCNT,@DISPLINE)=@DISPLINE+1
.E D ; adding in the middle or beginning; need to shift down
..D SHIFTDN(LINE,1)
.;
.; no matter where we added the new prescription, do the following:
.;
.S @DISP@(PAT,RXI)=LINE_U_U
.S @DISPLINE@(LINE)=PAT_U_RXI ; 02/02/2000
.S $P(@DISP@(PAT),U,4)=$P(@DISP@(PAT),U,4)+1
;
UPD3 ; this patient is already in our list (maybe having just been added)
; The patient and all of his prescriptions have display space
; Now we can deal with the actual changes (date-time of change,status)
;I $P($G(^ABSP(9002313.99,1,"ABSPOS6*")),U,2) S $ZT="ERR^ZU"
S RXI="" F I=1:1:@CHG@(PAT) D
.;K ^ABSTMP("ABSPOS SAVE",$J) M ^ABSTMP("ABSPOS SAVE",$J)=^TMP("ABSPOS",$J) ; TEMPORARY TEMPORARY TEMPORARY
.S RXI=$O(@CHG@(PAT,"RXI",RXI)) ; next changed prescription
.N X S X=@CHG@(PAT,"RXI",RXI) ; status^dateTimeof last change
.;D DISPHIST("UPD3:"_PAT_" "_RXI_":"_X)
.I '$D(@DISP@(PAT,RXI)) D LOGERR^ABSPOS6F("UPD3^ABSPOS") ; 01/27/2000
.I X=$P(@DISP@(PAT,RXI),U,2,3) D Q ; we saw this last time around
..D DISPHIST("UPD3: already processed this one, so quit early")
UPD4 .N S,D S S=$P(X,U),D=$P(X,U,2)
.; NO! I D>^TMP("ABSPOS",$J,"LAST UPDATE") S ^("LAST UPDATE")=D
.;D DISPHIST("UPD3: reset LAST UPDATE to "_D)
.N L S L=$P(@DISP@(PAT,RXI),U) ; line #
UPD5 .I S=100,$P(@DISP@(PAT,RXI),U,2)'=100 D ; marking as complete
..N B S B=$$BUCKET^ABSPOS6B(RXI)
..; NO! S $P(@DISP@(PAT),U,4)=$P(@DISP@(PAT),U,4)+1
..S $P(@DISP@(PAT),U,B)=$P(@DISP@(PAT),U,B)+1
.S @DISP@(PAT,RXI)=L_U_S_U_D ; line^status^dateTime of change
.;D DISPHIST("UPD3: PAT REC BEFORE:"_@DISP@(PAT))
UPD6 .I D>$P(@DISP@(PAT),U,3) S $P(@DISP@(PAT),U,3)=D,PATCHG=1
.;D DISPHIST("UPD3: PAT REC AFTER:"_@DISP@(PAT))
.D SETLINE^ABSPOS6H(L,PAT,RXI) ; update list manager data and disp. if visible
;
UPD7 ; Sum the total of the statuses - used for computing %done
N TOTSTAT S TOTSTAT=0
S RXI="" F I=1:1:$P(@DISP@(PAT),U,4) D
.S RXI=$O(@DISP@(PAT,RXI))
.S TOTSTAT=TOTSTAT+$P(@DISP@(PAT,RXI),U,2)
I TOTSTAT'=$P(@DISP@(PAT),U,2) S PATCHG=1 ; total of statuses changed
S $P(@DISP@(PAT),U,2)=TOTSTAT
D DISPHIST("After summing:"_@DISP@(PAT))
;
; If the patient data changed, update the list manager data and
; if the line is visible, update the display, too
;
I PATCHG D SETLINE^ABSPOS6H($P(@DISP@(PAT),U),PAT)
Q
VISIBLE(LINE) ;EP - from ABSPOS6H - is LINE number visible?
; HARDCODED!!! list region is from line 6 to line 18
; ASSUMPTION!! VALMBG is the first line number displayed
; so lines VALMBG through VALMBG+(18-6) are visitble
I $G(NODISPLY) Q 0
I '$G(VALMBG) Q 0
I LINE<VALMBG Q 0
I LINE>(VALMBG+(18-6)) Q 0
Q 1
SHIFTDN(LINE,NLINES) ; as in when something is inserted
D DISPHIST("SHIFTDN(LINE,NLINES) for "_LINE_","_NLINES)
F I=VALMCNT:-1:LINE D
.D MOVELINE(I,I+NLINES)
S (@DISPLINE,VALMCNT)=VALMCNT+NLINES
Q
MOVELINE(FROM,TO,CLR) ;
D DISPHIST("Move line "_FROM_" to "_TO_";visible="_$$VISIBLE(TO)_","_$$VISIBLE(FROM))
D DISPHIST("VALMAR="_VALMAR)
M @DISPHIST@(@DISPHIST,"VALMAR")=@VALMAR
;I $P($G(^ABSP(9002313.99,1,"ABSPOS6*")),U,2) S $ZT="ERR^ZU"
I '$D(@DISPLINE@(FROM)) D LOGERR^ABSPOS6F("MOVELINE^ABSPOS") ;01/27/2000
N PAT,RXI,X S X=@DISPLINE@(FROM),PAT=$P(X,U),RXI=$P(X,U,2)
I $G(RXI) S $P(@DISP@(PAT,RXI),U)=TO
E S $P(@DISP@(PAT),U)=TO
S @DISPLINE@(TO)=@DISPLINE@(FROM)
D SET^VALM10(TO,@VALMAR@(FROM,0),TO) ; set destination = new contents
D FLDTEXT^VALM10(TO,"LINE NUMBER",$J(TO,2)) ; fix line number in dest
I $$VISIBLE(TO) D WRITE^VALM10(TO) ; if any visible, write them
I $G(CLR) D CLRLINE(FROM)
D DISPHIST("Move line "_FROM_" to "_TO_" complete")
Q
CLRLINE(N) ; clear out line N
D DISPHIST("Clearing line "_N_", $$VISIBLE(N)="_$$VISIBLE(N))
D SET^VALM10(N," ") ; clear contents of source line
I $$VISIBLE(N) D WRITE^VALM10(N)
S @DISPLINE@(N)="DELETED "_@DISPLINE@(N)
K @VALMAR@("IDX",N)
Q
SHIFTUP(FROM,TO) ; move upward from SRC to DST, all the way to end
D DISPHIST("SHIFTUP(FROM,TO) for "_FROM_","_TO)
I FROM'>TO D Q
. D IMPOSS^ABSPOSUE("P","TI","bad params FROM="_FROM_",TO="_TO,,"SHIFTUP",$T(+0))
N NLINES S NLINES=FROM-TO
F Q:FROM>VALMCNT D
.D MOVELINE(FROM,TO,0)
.S FROM=FROM+1,TO=TO+1
F D CLRLINE(TO) Q:TO=VALMCNT S TO=TO+1
S (VALMCNT,@DISPLINE)=VALMCNT-NLINES
Q
ABSPOS6I ; IHS/FCS/DRS - Data Entry & Status Disp ;
+1 ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
+2 ;
+3 ; ALL writes of screen lines as follows:
+4 ; IF $$VISIBLE(line) DO WRITE^VALM10(line)
+5 ; When approp., set NODISPLY=true and $$VISIBLE returns false
+6 QUIT
+7 ; DISPDBG: are we debugging the display?
DISPDBG() QUIT $PIECE($GET(^ABSP(9002313.99,1,"ABSPOS6*")),U)
DISPHIST(MSG,HANG) ; DEBUGGING - to record history and pause
+1 IF '$$DISPDBG
QUIT
+2 IF '$DATA(HANG)
SET HANG=1
+3 DO DISPHIST^ABSPOS6H(MSG,HANG)
+4 QUIT
UPDATE(COUNTER) ;EP - from ABSPOS6A
+1 ; with COUNTER = a count down, -1 for indefinite repeat
+2 NEW CHGCOUNT
SET CHGCOUNT=0
+3 NEW STOP
FOR
Begin DoDot:1
+4 DO UPD1
+5 SET COUNTER=COUNTER-1
IF 'COUNTER
SET STOP=1
QUIT
+6 IF '$GET(NODISPLY)
Begin DoDot:2
+7 DO MSG^VALM10("In continuous update mode: press Q to Quit")
+8 ;R X#1:^TMP("ABSPOS",$J,"FREQ") D MSG^VALM10(" ")
NEW X
+9 ;Try doing this single-character read with ^XGKB
+10 ;I $D(^TMP("XGKEY",$J)) ; possible interference
+11 SET X=$$READ^XGKB(1,^TMP("ABSPOS",$JOB,"FREQ"))
+12 ;I X]"","Qq^^"[X S STOP=1
+13 IF '$GET(DTOUT)
IF X]""
IF "Qq^^"[X
SET STOP=1
+14 ; clean out typeahead (like mistaken arrow keys)
NEW Y
FOR
READ Y:0
IF '$TEST
QUIT
End DoDot:2
End DoDot:1
IF $GET(STOP)
QUIT
+15 QUIT
UPD1 ; one update cycle
+1 NEW NOW,PAT,RXI,T,CHG,LAST,OLDEST,ONEPAT
Begin DoDot:1
+2 NEW %,%H,%I,X
DO NOW^%DTC
SET NOW=%
End DoDot:1
+3 SET ONEPAT=^TMP("ABSPOS",$JOB,"PATIENT")
+4 IF ONEPAT
Begin DoDot:1
+5 SET T=^TMP("ABSPOS",$JOB,"PATIENT TIME")
+6 SET CHG=$$SORT^ABSPOSUA(0,ONEPAT,T,1)
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 ; absolute time on 2nd & subseq
SET T=^TMP("ABSPOS",$JOB,"LAST UPDATE")
+9 ; delta time on 1st call
IF T=""
SET T=^TMP("ABSPOS",$JOB,"TIME")
+10 ; remember the time you did this
SET ^TMP("ABSPOS",$JOB,"LAST UPDATE")=NOW
+11 ; get changes
SET CHG=$$SORT^ABSPOSUA(^TMP("ABSPOS",$JOB,"USER"),,T)
End DoDot:1
+12 SET OLDEST=$$TADD^ABSPOSUD(NOW,-^TMP("ABSPOS",$JOB,"TIME"))
+13 ;
+14 ; Deal with dismissals
+15 ;
+16 SET PAT=""
FOR
SET PAT=$ORDER(@DISMISS@(PAT))
IF PAT=""
QUIT
Begin DoDot:1
+17 IF PAT'?1"*".E
IF 'ONEPAT
QUIT
+18 ; dismissal order expired
IF @DISMISS@(PAT)<OLDEST
KILL @DISMISS@(PAT)
QUIT
+19 ; no changes for this patient
IF '$DATA(@CHG@(PAT))
QUIT
+20 SET RXI=""
FOR
SET RXI=$ORDER(@DISMISS@(PAT,RXI))
IF RXI=""
QUIT
Begin DoDot:2
+21 ; order expired
IF @DISMISS@(PAT,RXI)<OLDEST
KILL @DISMISS@(PAT,RXI)
QUIT
+22 ; a change has occurred in a dismissed RX
IF $DATA(@CHG@(PAT,RXI))
Begin DoDot:3
+23 ; so ignore the change
KILL @CHG@(PAT,RXI)
+24 ; and maybe patient is empty
IF $ORDER(@CHG@(PAT,""))=""
KILL @CHG@(PAT)
End DoDot:3
End DoDot:2
End DoDot:1
+25 SET CHGCOUNT=$GET(CHGCOUNT)+1
+26 IF $$DISPDBG
Begin DoDot:1
+27 DO DISPHIST("CHGCOUNT="_CHGCOUNT_" computed with T="_T)
+28 KILL ^TMP("ABSPOS",$JOB,"CHG",CHGCOUNT)
+29 MERGE ^TMP("ABSPOS",$JOB,"CHG",CHGCOUNT)=@CHG
End DoDot:1
+30 ; And you have DISP,DISPLINE,DISPIDX already set up from caller
+31 ;
+32 ; Now deal with any surviving changes
+33 ;
+34 SET PAT=""
FOR
SET PAT=$ORDER(@CHG@(PAT))
IF PAT=""
QUIT
DO UPDPAT
+35 ;
+36 ; And finally, weed out any which haven't seen any changes
+37 ; in the last ^TMP("ABSPOS",$J,"TIME") time
+38 ;
+39 IF 'ONEPAT
SET PAT=""
FOR
SET PAT=$ORDER(@DISP@(PAT))
IF PAT=""
QUIT
Begin DoDot:1
+40 ; last update for this patient
SET X=@DISP@(PAT)
SET LAST=$PIECE(X,U,3)
+41 ; old & complete
IF LAST<OLDEST
IF $PIECE(X,U,4)*100=$PIECE(X,U,2)
Begin DoDot:2
+42 DO DISPHIST("Deleting "_PAT_" "_LAST_"<"_OLDEST)
+43 ; how many line this one occupies
NEW NLINES
SET NLINES=$PIECE(X,U,4)+1
+44 ;
DO SHIFTUP($PIECE(X,U)+NLINES,$PIECE(X,U))
+45 KILL @DISP@(PAT)
End DoDot:2
End DoDot:1
+46 QUIT
UPDPAT ; Update for a given @CHG@(PAT)
+1 ;I $P($G(^ABSP(9002313.99,1,"ABSPOS6*")),U,2) S $ZT="ERR^ZU"
+2 NEW NEWPAT,RXI,I
+3 ; "patient changed", set to 1 if so
NEW PATCHG
SET PATCHG=0
+4 DO DISPHIST("UPDPAT for PAT="_PAT,0)
+5 ;
+6 ; nope, we already have them
IF $DATA(@DISP@(PAT))
SET NEWPAT=0
GOTO UPD2
+7 ;
+8 DO DISPHIST("New patient not yet on our list",0)
+9 ; set "new patient" flag
SET (NEWPAT,PATCHG)=1
+10 ; how many prescriptions
NEW NPRESC
SET NPRESC=@CHG@(PAT)
+11 ; plus one more line for the patient
NEW NLINES
SET NLINES=NPRESC+1
+12 ; overflow
IF VALMCNT+NLINES>^TMP("ABSPOS",$JOB,"MAX LINES")
QUIT
+13 NEW PATNEXT
SET PATNEXT=$ORDER(@DISP@(PAT))
+14 ; the new patient and prescriptions go at end
IF PATNEXT=""
Begin DoDot:1
+15 ; this is the new line number
SET LINE=@DISPLINE+1
+16 ; update count of total lines
SET (VALMCNT,@DISPLINE)=@DISPLINE+NLINES
+17 DO DISPHIST("Goes at end, on line #"_LINE,0)
End DoDot:1
+18 ; the new patient pushes the next one downward
IF '$TEST
Begin DoDot:1
+19 DO DISPHIST("Pushes existing ones at line "_LINE_" down "_NLINES,1)
+20 SET LINE=$PIECE(@DISP@(PATNEXT),U)
+21 DO SHIFTDN(LINE,NLINES)
End DoDot:1
+22 ;
+23 ; common handling for new patient, whether at end or not
+24 ;
+25 SET @DISP@(PAT)=LINE_U_U_U_NPRESC
+26 ; remember who's stored here
SET @DISPLINE@(LINE)=PAT_U
+27 ;
+28 ; Init for each prescription that came with this new patient
+29 ;
+30 ; should always get @CHG@(PAT) iterations, right?
SET RXI=""
+31 FOR I=1:1:@CHG@(PAT)
SET RXI=$ORDER(@CHG@(PAT,"RXI",RXI))
IF RXI=""
QUIT
Begin DoDot:1
+32 SET @DISP@(PAT,RXI)=(LINE+I)_U_U
+33 SET @DISPLINE@(LINE+I)=PAT_U_RXI
End DoDot:1
+34 ;
+35 ; and fall through to treat the rest of it same as existing patient
+36 GOTO UPD3
UPD2 ;
+1 ; Patient was already in our list, but maybe there are
+2 ; new prescriptions for which we must make room
+3 ;
+4 SET RXI=""
FOR I=1:1:@CHG@(PAT)
SET RXI=$ORDER(@CHG@(PAT,"RXI",RXI))
Begin DoDot:1
+5 ; prescription already has a spot
IF $DATA(@DISP@(PAT,RXI))
QUIT
+6 ; overflow
IF VALMCNT+1>^TMP("ABSPOS",$JOB,"MAX LINES")
QUIT
+7 ; protect index
NEW I
+8 DO DISPHIST("New prescription "_RXI_" for "_PAT,0)
+9 ;
+10 ; a new prescription for the already-existent patient
+11 ; assign a line for it and shift everything else down
+12 ;
+13 ; flag: "patient info has changed"
SET PATCHG=1
+14 NEW ADDATEND
+15 NEW RXINEXT
SET RXINEXT=$ORDER(@DISP@(PAT,RXI))
+16 IF RXINEXT
SET LINE=$PIECE(@DISP@(PAT,RXINEXT),U)
SET ADDATEND=0
+17 ; prescription comes at end of this patient's stuff
IF '$TEST
Begin DoDot:2
+18 NEW PATNEXT
SET PATNEXT=$ORDER(@DISP@(PAT))
+19 IF PATNEXT=""
SET ADDATEND=1
+20 IF '$TEST
SET LINE=$PIECE(@DISP@(PATNEXT),U)
SET ADDATEND=0
End DoDot:2
+21 ; adding at end, nothing needs to be shifted down
IF ADDATEND
Begin DoDot:2
+22 SET LINE=@DISPLINE+1
SET (VALMCNT,@DISPLINE)=@DISPLINE+1
End DoDot:2
+23 ; adding in the middle or beginning; need to shift down
IF '$TEST
Begin DoDot:2
+24 DO SHIFTDN(LINE,1)
End DoDot:2
+25 ;
+26 ; no matter where we added the new prescription, do the following:
+27 ;
+28 SET @DISP@(PAT,RXI)=LINE_U_U
+29 ; 02/02/2000
SET @DISPLINE@(LINE)=PAT_U_RXI
+30 SET $PIECE(@DISP@(PAT),U,4)=$PIECE(@DISP@(PAT),U,4)+1
End DoDot:1
+31 ;
UPD3 ; this patient is already in our list (maybe having just been added)
+1 ; The patient and all of his prescriptions have display space
+2 ; Now we can deal with the actual changes (date-time of change,status)
+3 ;I $P($G(^ABSP(9002313.99,1,"ABSPOS6*")),U,2) S $ZT="ERR^ZU"
+4 SET RXI=""
FOR I=1:1:@CHG@(PAT)
Begin DoDot:1
+5 ;K ^ABSTMP("ABSPOS SAVE",$J) M ^ABSTMP("ABSPOS SAVE",$J)=^TMP("ABSPOS",$J) ; TEMPORARY TEMPORARY TEMPORARY
+6 ; next changed prescription
SET RXI=$ORDER(@CHG@(PAT,"RXI",RXI))
+7 ; status^dateTimeof last change
NEW X
SET X=@CHG@(PAT,"RXI",RXI)
+8 ;D DISPHIST("UPD3:"_PAT_" "_RXI_":"_X)
+9 ; 01/27/2000
IF '$DATA(@DISP@(PAT,RXI))
DO LOGERR^ABSPOS6F("UPD3^ABSPOS")
+10 ; we saw this last time around
IF X=$PIECE(@DISP@(PAT,RXI),U,2,3)
Begin DoDot:2
+11 DO DISPHIST("UPD3: already processed this one, so quit early")
End DoDot:2
QUIT
UPD4 NEW S,D
SET S=$PIECE(X,U)
SET D=$PIECE(X,U,2)
+1 ; NO! I D>^TMP("ABSPOS",$J,"LAST UPDATE") S ^("LAST UPDATE")=D
+2 ;D DISPHIST("UPD3: reset LAST UPDATE to "_D)
+3 ; line #
NEW L
SET L=$PIECE(@DISP@(PAT,RXI),U)
UPD5 ; marking as complete
IF S=100
IF $PIECE(@DISP@(PAT,RXI),U,2)'=100
Begin DoDot:2
+1 NEW B
SET B=$$BUCKET^ABSPOS6B(RXI)
+2 ; NO! S $P(@DISP@(PAT),U,4)=$P(@DISP@(PAT),U,4)+1
+3 SET $PIECE(@DISP@(PAT),U,B)=$PIECE(@DISP@(PAT),U,B)+1
End DoDot:2
+4 ; line^status^dateTime of change
SET @DISP@(PAT,RXI)=L_U_S_U_D
+5 ;D DISPHIST("UPD3: PAT REC BEFORE:"_@DISP@(PAT))
UPD6 IF D>$PIECE(@DISP@(PAT),U,3)
SET $PIECE(@DISP@(PAT),U,3)=D
SET PATCHG=1
+1 ;D DISPHIST("UPD3: PAT REC AFTER:"_@DISP@(PAT))
+2 ; update list manager data and disp. if visible
DO SETLINE^ABSPOS6H(L,PAT,RXI)
End DoDot:1
+3 ;
UPD7 ; Sum the total of the statuses - used for computing %done
+1 NEW TOTSTAT
SET TOTSTAT=0
+2 SET RXI=""
FOR I=1:1:$PIECE(@DISP@(PAT),U,4)
Begin DoDot:1
+3 SET RXI=$ORDER(@DISP@(PAT,RXI))
+4 SET TOTSTAT=TOTSTAT+$PIECE(@DISP@(PAT,RXI),U,2)
End DoDot:1
+5 ; total of statuses changed
IF TOTSTAT'=$PIECE(@DISP@(PAT),U,2)
SET PATCHG=1
+6 SET $PIECE(@DISP@(PAT),U,2)=TOTSTAT
+7 DO DISPHIST("After summing:"_@DISP@(PAT))
+8 ;
+9 ; If the patient data changed, update the list manager data and
+10 ; if the line is visible, update the display, too
+11 ;
+12 IF PATCHG
DO SETLINE^ABSPOS6H($PIECE(@DISP@(PAT),U),PAT)
+13 QUIT
VISIBLE(LINE) ;EP - from ABSPOS6H - is LINE number visible?
+1 ; HARDCODED!!! list region is from line 6 to line 18
+2 ; ASSUMPTION!! VALMBG is the first line number displayed
+3 ; so lines VALMBG through VALMBG+(18-6) are visitble
+4 IF $GET(NODISPLY)
QUIT 0
+5 IF '$GET(VALMBG)
QUIT 0
+6 IF LINE<VALMBG
QUIT 0
+7 IF LINE>(VALMBG+(18-6))
QUIT 0
+8 QUIT 1
SHIFTDN(LINE,NLINES) ; as in when something is inserted
+1 DO DISPHIST("SHIFTDN(LINE,NLINES) for "_LINE_","_NLINES)
+2 FOR I=VALMCNT:-1:LINE
Begin DoDot:1
+3 DO MOVELINE(I,I+NLINES)
End DoDot:1
+4 SET (@DISPLINE,VALMCNT)=VALMCNT+NLINES
+5 QUIT
MOVELINE(FROM,TO,CLR) ;
+1 DO DISPHIST("Move line "_FROM_" to "_TO_";visible="_$$VISIBLE(TO)_","_$$VISIBLE(FROM))
+2 DO DISPHIST("VALMAR="_VALMAR)
+3 MERGE @DISPHIST@(@DISPHIST,"VALMAR")=@VALMAR
+4 ;I $P($G(^ABSP(9002313.99,1,"ABSPOS6*")),U,2) S $ZT="ERR^ZU"
+5 ;01/27/2000
IF '$DATA(@DISPLINE@(FROM))
DO LOGERR^ABSPOS6F("MOVELINE^ABSPOS")
+6 NEW PAT,RXI,X
SET X=@DISPLINE@(FROM)
SET PAT=$PIECE(X,U)
SET RXI=$PIECE(X,U,2)
+7 IF $GET(RXI)
SET $PIECE(@DISP@(PAT,RXI),U)=TO
+8 IF '$TEST
SET $PIECE(@DISP@(PAT),U)=TO
+9 SET @DISPLINE@(TO)=@DISPLINE@(FROM)
+10 ; set destination = new contents
DO SET^VALM10(TO,@VALMAR@(FROM,0),TO)
+11 ; fix line number in dest
DO FLDTEXT^VALM10(TO,"LINE NUMBER",$JUSTIFY(TO,2))
+12 ; if any visible, write them
IF $$VISIBLE(TO)
DO WRITE^VALM10(TO)
+13 IF $GET(CLR)
DO CLRLINE(FROM)
+14 DO DISPHIST("Move line "_FROM_" to "_TO_" complete")
+15 QUIT
CLRLINE(N) ; clear out line N
+1 DO DISPHIST("Clearing line "_N_", $$VISIBLE(N)="_$$VISIBLE(N))
+2 ; clear contents of source line
DO SET^VALM10(N," ")
+3 IF $$VISIBLE(N)
DO WRITE^VALM10(N)
+4 SET @DISPLINE@(N)="DELETED "_@DISPLINE@(N)
+5 KILL @VALMAR@("IDX",N)
+6 QUIT
SHIFTUP(FROM,TO) ; move upward from SRC to DST, all the way to end
+1 DO DISPHIST("SHIFTUP(FROM,TO) for "_FROM_","_TO)
+2 IF FROM'>TO
Begin DoDot:1
+3 DO IMPOSS^ABSPOSUE("P","TI","bad params FROM="_FROM_",TO="_TO,,"SHIFTUP",$TEXT(+0))
End DoDot:1
QUIT
+4 NEW NLINES
SET NLINES=FROM-TO
+5 FOR
IF FROM>VALMCNT
QUIT
Begin DoDot:1
+6 DO MOVELINE(FROM,TO,0)
+7 SET FROM=FROM+1
SET TO=TO+1
End DoDot:1
+8 FOR
DO CLRLINE(TO)
IF TO=VALMCNT
QUIT
SET TO=TO+1
+9 SET (VALMCNT,@DISPLINE)=VALMCNT-NLINES
+10 QUIT
