- 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