ABSPOS1.m

ABSPOS1 ; IHS/UNK/UNK ; less commonly called subroutines [ 10/13/2000  9:06 AM ]

 ;;1.0;PHARMACY POINT OF SALE;**49**;JUN 21, 2001;Build 38

 Q

PRINTALL ; print all patients' results  ABSB POS RXE P1 PRINT ALL

 N IO I '$$DEVICE G PRINT99

 U $P D:IO=$P FULL^VALM1 U IO

 D PRINTHDR

 N A S A="" F  S A=$O(@VALMAR@(A)) Q:'A  D PRINTA(A)

 G PRINT9

PRINTHDR ; print a header

 W VALM("TITLE")," " D ^%D W " " D ^%T W !!

 N A S A="" F  S A=$O(VALMHDR(A)) Q:A=""  W VALMHDR(A),!

 W !

 Q

PRINTA(A) ; print line A

 ; How could you tell whether this is a patient line or a prescription

 ; line?  And which patient or prescription is represented?

 ; Look at @DISPLINE(n)=patname or patname^rxi

 ; Look at @VALMIDX@(n,patien), @VALMIDX@(n,patien,rxien)

 I '$D(IOM) N IOM S IOM=80

 N X D

 .I $D(@VALMAR@(A,0)) S X=@VALMAR@(A,0)

 .E  S X="(? Line "_A_" is missing?)"

 .F  Q:$E(X,$L(X))'=" "  S X=$E(X,1,$L(X)-1)

 .N M,N S M=32,N=IOM-M

 .W $E(X,1,IOM),! S X=$E(X,IOM+1,$L(X))

 .F  Q:X=""  W ?M-3,"...",$E(X,1,N),! S X=$E(X,N+1,$L(X))

 Q

PRINT ; print a patient's results  ABSB POS RXE P1 PRINT PATIENT

 ; More aptly, it's "print selected lines"

 W !,"Enter the line numbers you wish to print.  For example,",!

 W "enter    3-7     to print lines 3 through 7.",!

 N IEN D SELECPAT(.IEN) ; select a patient(s)

 I $D(IEN)<10 G PRINT99 ; none selected

 N IO I '$$DEVICE G PRINT99

 U $P D:IO=$P FULL^VALM1 U IO

 D PRINTHDR

 N A S A="" F  S A=$O(IEN(A)) Q:A=""  D PRINTA(A)

PRINT9 ; joined here from PRINTALL,CLAIMLOG

 D BYE^ABSPOSU5 ; this does DO ^%ZISC to close IO for you

PRINT99 ; joined here from PRINTALL,CLAIMLOG

 D ANY^ABSPOS2A ;PressAny^ABSPOSU5()

PRINT999 S VALMBCK="R" ;$S(VALMCC:"",1:"R")

 Q

MAKERXI ; IEN(*)=line numbers  we want to convert to prescription numbers

 ; builds RXI(*)="" or maybe data, ignore whatever you get on right side

 S IEN="" F  S IEN=$O(IEN(IEN)) Q:IEN=""  D MRXI

 Q

MRXI S RXI=$P(@DISPLINE@(IEN),U,2)

 I RXI S RXI(RXI)="" Q  ; a prescription detail line; take just the one

 ; else it's a patient line - take all of this patient's prescrip's

 N PAT S PAT=$P(@DISPLINE@(IEN),U)

 M RXI=@DISP@(PAT) ; merge in all of the patient's prescriptions

 Q  ; with RXI(*) array set up

CLAIMLOG ; print a claim log  ABSB RXE POS RXE P1 CLAIM LOG

 W !,"Enter the line numbers for which you wish to print claim logs.",!

 N IEN D SELECPAT(.IEN) ; select prescription(s) or patients

 I $D(IEN)<10 G PRINT99

 N IO I '$$DEVICE G PRINT99

 U $P D:IO=$P FULL^VALM1 U IO

 N RXI D MAKERXI ; IEN(*) -> converted to RXI(*)

 ; now RXI(*) is the array of RXI's we want to print logs for

 S RXI="" F  S RXI=$O(RXI(RXI)) Q:RXI=""  D CLAIMLOG^ABSBPOS(RXI,IO)

 D BYE^ABSPOSU5

 G PRINT9

RECEIPT ; print receipts

 W !,"Enter the line numbers for which you wish to print ",$$NAME^ABSPOS8(3),".",!

 N IEN D SELECPAT(.IEN) ; select prescription(s) or patients

 I $D(IEN)<10 G PRINT99

 N IO I '$$DEVICE G PRINT99

 U $P D:IO=$P FULL^VALM1

 N RXI D MAKERXI ; IEN(*) -> converted to RXI(*)

 D RECEIPTS^ABSPOS8(.RXI,IO)

 D BYE^ABSPOSU5

 G PRINT9

REVERSE ; reverse selected claims  ABSB RXE POS RXE P1 REVERSE

 W "Select the line(s) with the paid claim(s) you wish to REVERSE.",!

 N IEN D SELECPAT(.IEN) ; select which ones to reverse

 N RXI D MAKERXI ; IEN(*) -> converted to RXI(*)

 D FULL^VALM1

 N REVTOTAL,REVELECT,ERRCOUNT S (REVTOTAL,REVELECT,ERRCOUNT)=0

 S RXI="" F  S RXI=$O(RXI(RXI)) Q:RXI=""  D

 . N X S X=$$REVERS59(RXI,0)

 . I X D

 . . S REVTOTAL=REVTOTAL+1

 . . I X>.5 S REVELECT=REVELECT+1

 . E  D

 . . W "Cannot reverse ",RXI,! S ERRCOUNT=ERRCOUNT+1

 W REVTOTAL," claim reversal",$S(REVTOTAL'=1:"s",1:"")," in progress.",!

 I ERRCOUNT D

 . W "Some claim(s) could not be reversed because only paper claims",!

 . W "and Payable electronic claims can be reversed.",!

 I REVELECT D TASK^ABSPOSQ1 ; task up a packetizer

 D ANY^ABSPOS2A ;D PressAny^ABSPOSU5()

 N NODISPLY S NODISPLY=1 D UPD^ABSPOS6A

 S VALMBCK="R"

 ;S VALMBCK=""

 Q

REVERS59(IEN59,WANTQ2)    ; called here from ABSPOSRX too

 ; IEN59 as usual; $G(WANT2Q)=TRUE if you want packetizer started

 ; Returns 0 if no, no reversal, it's unreversable

 ; Returns 0.5 if it's a paper claim that was reversed

 ; Returns IEN of reversal claim if electronic claim submitted for

 ;   reversal.

 N RESULT S RESULT=$$CATEG^ABSPOSB2(IEN59)

 I RESULT'="PAPER",RESULT'="E PAYABLE",RESULT'="E DUPLICATE" Q:$Q 0 Q

 I RESULT="PAPER REVERSAL"!(RESULT="E REVERSAL ACCEPTED") Q:$Q 0 Q

 ; Okay, reversal is permitted

 D PREVISLY^ABSPOSIZ(IEN59) ; bracket result text with [Previously: ]

 I RESULT="PAPER" D REVERSP(IEN59) Q:$Q 0.5 Q

 ; Here, reversal of electronic claim:

 N CLAIMIEN S CLAIMIEN=$P(^ABSPEC(9002335.59,IEN59,0),U,4) ; the claim

 N POS S POS=$P(^ABSPEC(9002335.59,IEN59,0),U,9) ; and position therein

 N REV S REV=$$REVERSE^ABSPECA8(CLAIMIEN,POS) ; construct reversal

 D  ;S $P(^ABSPEC(9002335.59,IEN59,4),U)=REV ; mark claim with reversal

 . N DIE,DR,DA S DIE=9002335.59,DA=IEN59,DR="401////"_REV D ^DIE

 N ABSBRXI S ABSBRXI=IEN59 D SETSTAT^ABSBPOSR(30) ; waiting to packetize

 I $G(WANT2Q) D TASK^ABSPOSQ1

 Q:$Q REV Q

REVERSP(IEN59)     ; reverse the given paper claim

 N ABSBRXI,OLDSLOT,X,MSG S MSG="Reversed paper claim"

 S $P(^ABSPEC(9002335.59,IEN59,4),U,3)=1

 S ABSBRXI=IEN59 D SETSTAT^ABSBPOSR(99)

 D SETRESU^ABSBPOSR(1,MSG)

 S OLDSLOT=$$GETSLOT^ABSBPOSU

 D INIT^ABSBPOSU(IEN59,1)

 D LOG^ABSBPOSU(MSG)

 D RELSLOT^ABSBPOSU

 I OLDSLOT D SETSLOT^ABSBPOSU(OLDSLOT)

 Q

RESUBMIT ;

 W "Select the line(s) with the claim(s) you wish to RESUBMIT.",!

 N IEN D SELECPAT(.IEN) ; gives IEN(*)

 N RXI D MAKERXI ; IEN(*) -> converted to RXI(*)

 D FULL^VALM1

 N REVCOUNT S REVCOUNT=0

 N IEN59 S IEN59="" F  S IEN59=$O(RXI(IEN59)) Q:IEN59=""  D

 .N X S X=$$RESULT59^ABSPOSRX(IEN59)

 .I X="E PAYABLE"!(X="E DUPLICATE")!(X="E REVERSAL REJECTED") D  Q

 ..W "`",IEN59," is Payable; you must REVERSE it first.",!

 .I X="PAPER" D

 ..W "`",IEN59," is a paper claim; it will be implicitly reversed",!

 .D RESUB1(IEN59)

 .D PREVISLY^ABSPOSIZ(IEN59)

 .W "Resubmitted `",IEN59,! H 1

 D TASK^ABSPOSIZ ; task up a "gathering claim info" job

 D ANY^ABSPOS2A ;D PressAny^ABSPOSU5()

 N NODISPLY S NODISPLY=1 D UPD^ABSPOS6A

 S VALMBCK="R"

 Q

RESUB1(IEN59)        ; resubmit one entry in .59 ; caller responsible for

 ; starting up  D TASK^ABSPOSIZ

 ; Also called here from ABSBPOSR, for reverse-and-resubmit action

 ;Kill pointers of previous submissions and reversals

 N DIE,DR,DA S DIE=9002335.59,DA=IEN59

 S DR="" N I F I=3,4,401:1:403,301:1:302,801:1:803 D

 . S:DR]"" DR=DR_";" S DR=DR_I_"///@"

 D ^DIE

 ;D PREVISLY^ABSPOSIZ(IEN59) ; bracket result text with "[Previously: ]"

 ; Reset status

 N ABSBRXI S ABSBRXI=IEN59 D SETSTAT^ABSBPOSR(0)

 Q

DEVICE() ; device selection for POS

 ; want to provide a convenient default

 N DEFAULT S DEFAULT="HOME"

 N DEVICE S DEVICE=$$DEVICE^ABSPOSU8(DEFAULT)

 I 'DEVICE Q ""

 Q DEVICE

CANCEL ; cancel a claim  ABSB POS RXE P1 CANCEL CLAIM

 N LINE

 W !,"Select prescription to cancel by line number.  Hurry!"

 D SELECPAT(.LINE)

 I $O(LINE(""))="" W !,"None selected for cancellation",! G CAN99

 I 0 D FULL^VALM1 W "Temporary for debugging:",! D

 .ZW LINE

 .N TMP M TMP=@DISP ZW TMP

 .N % R ">>>",%

 S LINE="" F  S LINE=$O(LINE(LINE)) Q:LINE=""  D

 .N PAT,RXI S PAT=$P(@DISPLINE@(LINE),U),RXI=$P(@DISPLINE@(LINE),U,2)

 .I RXI D CANC5^ABSBPOS Q

 .; else patient was selected; cancel all of this patient's claims

 .S RXI="" F  S RXI=$O(@DISP@(PAT,RXI)) Q:RXI=""  D CANC5^ABSBPOS

 W !,"Cancellation requests made." H 1

CAN99 D ANY^ABSPOS2A ;D PressAny^ABSPOSU5()

 N NODISPLY DO UPD^ABSPOS6A S VALMBCK="R"

 Q

DISMISS ; dismiss a patient from my screen  ABSB POS RXE P1 DISMISS PATIENT

 ; This is to remove a patient from the display before the usual

 ; time window has expired.  Do it by:

 ; 1. Set @DISMISS nodes to 15 minutes from now, so as to keep

 ;    the patient and prescription off our screen until then.

 ; 2. Zero out the time of last update in @DISP so that the

 ;    winnowing thinks the entry is too old to keep around.

 ; This functionality is provided with the intent to support

 ; dismissing an entire patient's record after all processing

 ; has been completed.  Unusual usage may not have the results

 ; you presume it might have.

DIS0 N IEN,TIME,X,%,%I,%H D NOW^%DTC

 S TIME=$$TADD^ABSBPOS(%,^TMP("ABSPOS",$J,"TIME"))

 D SELECPAT(.IEN)

 S IEN="" F  S IEN=$O(IEN(IEN)) Q:IEN=""  D

 .N PAT,RXI S PAT=@DISPLINE@(IEN),RXI=$P(PAT,U,2),PAT=$P(PAT,U)

 .S @DISMISS@(PAT)=TIME

 .;I '$D(@DISP@(PAT)) W "DISP=",DISP," and @DISP@(PAT) is undef",! H 2

 .I $D(@DISP@(PAT)) S $P(@DISP@(PAT),U,3)=0

 .;I  W "Now @DISP@(PAT)=",@DISP@(PAT),! H 2

 .W PAT," will be dismissed.",! H 1

 .I RXI D

 ..S @DISMISS@(PAT,RXI)=TIME

 ..I $D(@DISP@(PAT,RXI)) S $P(@DISP@(PAT,RXI),U,3)=0

 ..;W PAT," ",RXI," will be dismissed.",! H 1

DIS9 ; some other functions branch to here to go back to main screen

 N NODISPLY DO UPD^ABSPOS6A S VALMBCK="R"

 Q

HEADER ; edit header information ; ABSB POS RXE P1 HEADER

 ; (This is what the menu shows as EV Edit view screen)

 ; first, ask "All users or just one user or one patient?"

 D FULL^VALM1

 N WHO,TIMEWIN,PAT,PATTIME,UPDFREQ,DIC,DA,Y,X,DTOUT,DUOUT

 W !

HDR1 S X=$$Set^ABSPOSU3("Display for  1:One user  or  2:All users  or  3:One patient? ","1",0,"H","1:One user;2:All users;3:One patient")

 W !

 I X<1 G HDR8A

 ; Note: one user / one patient combination is not implemented 

 ;  If you choose one patient, you get them all, regardless of user,

 ;  and the time window for weeding out old ones does not apply.

 I X=2 S WHO=0 G HDR3

 I X=3 S WHO=0 G HDRA ; and later come back to HDR88 or HDR8A

HDR2 ; just one user - which one?

 S DIC=200,DIC(0)="AEMNQZ",DIC("A")="Select POS user: "

 S DIC("B")=$P(^VA(200,DUZ,0),U)

 ;S DIC("S")=screening, with Y=IEN, ^VA(200,Y,0) in naked

 D ^DIC W ! G HDR8A:$G(DUOUT)!$G(DTOUT),HDR1:Y<1 S WHO=+Y

HDR3 ; time frame to keep patient on screen

 W !,"Enter the number of MINUTES, the length of time that",!

 W "completed transactions will be retained on the screen.",!

 S X=^TMP("ABSPOS",$J,"TIME"),X=$P(X,".",2),X=X_"000000" ; hhmmss0000

 S Y=$E(X,1,2)*60+$E(X,3,4)

 S X=$$FreeText^ABSPOSU2("Retention time:  ",Y,1,1,6) W !

 I X<1 G HDR8A

 I X'?1N.N!(X>1439) W " ??" G HDR3

 S TIMEWIN="."_$TR($J(X\60,2)," ","0")_$TR($J(X#60,2)," ","0")

HDR4 ; Frequency of updates in continuous update mode

 ; HDRA rejoins here

 S X=5 ; minimum allowed value for frequency

 W !,"Enter the number of SECONDS between updates when the display",!

 W "is in CONTINUOUS UPDATE MODE.",!

 S X=$$Numeric^ABSPOSU2("Seconds between updates: ",^TMP("ABSPOS",$J,"FREQ"),0,X,9999,0) W !

 I X'?1N.N G HDR8A

 S UPDFREQ=X

HDR8 S ^TMP("ABSPOS",$J,"USER")=WHO

 I TIMEWIN'=^("TIME") S ^("TIME")=TIMEWIN,^("LAST UPDATE")=""

 S ^("FREQ")=UPDFREQ

 S ^TMP("ABSPOS",$J,"PATIENT")=0

HDR88 W !,"Settings have been changed.",!

 ; at this point, shouldn't we wipe everything off and rebuild?

 N NODISPLY S NODISPLY=1 D UPD^ABSPOS6A

 G HDR9

HDR8A W !,"No settings have been changed.",!

HDR9 W "Done",! H 2

 S VALMBCK="R"

 Q

HDRA ; display for which one patient?

 N BBLIMIT

 S DIC=2,DIC(0)="AEMQZ",DIC("A")="Prescriptions for which patient? "

 S DIC("S")="I $D(^ABSPEC(9002335.59,""AC"",Y))"

 D ^DIC W !

 G HDR9:$G(DUOUT)!$G(DTOUT),HDRA:(Y<1)  S PAT=+Y

 W !,"Enter the number of DAYS to go back to find"

 W !,"Point of Sale activity for ",$P(Y(0),U),"."

 W ! S X=^TMP("ABSPOS",$J,"PATIENT TIME")

 ; /IHS/OIT/RAM ; 16 OCT 2017 ; CR#09828 Changes the amount of time we can back-bill payers; change

 ;     1 year limit to a new field in the ABSP SETUP file with that parameter. Default is now 6 years.

 ; S BBLIMIT=+$G(^ABSP(9002313.99,1,"BACKLIMIT")) ; Grab default from ABSP SETUP file.

 ; I BBLIMIT=0 S BBLIMIT=2192 ; If there is no value, set it to 6 years (in days).

 S BBLIMIT=365 ; 31 OCT 17 ; CR 9828 IS NOW ON HOLD; CHANGE BACK TO ORIGINAL 1 YEAR BEHAVIOUR.

 S X=$$Numeric^ABSPOSU2("Number of days:  ",X,1,1,BBLIMIT) W !  ;; Side note - this will never work with the lowercase in the call...

 ; /IHS/OIT/RAM ; 16 OCT 2017 ; END OF CHANGES FOR CR#09828

 I X<1 G HDRA

 S PATTIME=X

 S ^TMP("ABSPOS",$J,"PATIENT")=PAT,^("PATIENT TIME")=PATTIME

 S ^TMP("ABSPOS",$J,"USER")=0

 G HDR88

SELECPAT(RET) ; Select a patient.  Returns patient IEN(s) in array

 N VALMA,VAMP,VALMI,VALMAT,VALMY

 D EN^VALM2(XQORNOD(0),"O") S VALMI=0 ; allow "O"ptionally answer

 W !

 M RET=VALMY

 Q

ABSPOS1   ; IHS/UNK/UNK ; less commonly called subroutines [ 10/13/2000  9:06 AM ]

 +1       ;;1.0;PHARMACY POINT OF SALE;**49**;JUN 21, 2001;Build 38

 +2        QUIT 

PRINTALL  ; print all patients' results  ABSB POS RXE P1 PRINT ALL

 +1        NEW IO

           IF '$$DEVICE

               GOTO PRINT99

 +2        USE $PRINCIPAL

           IF IO=$PRINCIPAL

               DO FULL^VALM1

           USE IO

 +3        DO PRINTHDR

 +4        NEW A

           SET A=""

           FOR 

               SET A=$ORDER(@VALMAR@(A))

               IF 'A

                   QUIT 

               DO PRINTA(A)

 +5        GOTO PRINT9

PRINTHDR  ; print a header

 +1        WRITE VALM("TITLE")," "

           DO ^%D

           WRITE " "

           DO ^%T

           WRITE !!

 +2        NEW A

           SET A=""

           FOR 

               SET A=$ORDER(VALMHDR(A))

               IF A=""

                   QUIT 

               WRITE VALMHDR(A),!

 +3        WRITE !

 +4        QUIT 

PRINTA(A) ; print line A

 +1       ; How could you tell whether this is a patient line or a prescription

 +2       ; line?  And which patient or prescription is represented?

 +3       ; Look at @DISPLINE(n)=patname or patname^rxi

 +4       ; Look at @VALMIDX@(n,patien), @VALMIDX@(n,patien,rxien)

 +5        IF '$DATA(IOM)

               NEW IOM

               SET IOM=80

 +6        NEW X

           Begin DoDot:1

 +7            IF $DATA(@VALMAR@(A,0))

                   SET X=@VALMAR@(A,0)

 +8           IF '$TEST

                   SET X="(? Line "_A_" is missing?)"

 +9            FOR 

                   IF $EXTRACT(X,$LENGTH(X))'=" "

                       QUIT 

                   SET X=$EXTRACT(X,1,$LENGTH(X)-1)

 +10           NEW M,N

               SET M=32

               SET N=IOM-M

 +11           WRITE $EXTRACT(X,1,IOM),!

               SET X=$EXTRACT(X,IOM+1,$LENGTH(X))

 +12           FOR 

                   IF X=""

                       QUIT 

                   WRITE ?M-3,"...",$EXTRACT(X,1,N),!

                   SET X=$EXTRACT(X,N+1,$LENGTH(X))

           End DoDot:1

 +13       QUIT 

PRINT     ; print a patient's results  ABSB POS RXE P1 PRINT PATIENT

 +1       ; More aptly, it's "print selected lines"

 +2        WRITE !,"Enter the line numbers you wish to print.  For example,",!

 +3        WRITE "enter    3-7     to print lines 3 through 7.",!

 +4       ; select a patient(s)

           NEW IEN

           DO SELECPAT(.IEN)

 +5       ; none selected

           IF $DATA(IEN)<10

               GOTO PRINT99

 +6        NEW IO

           IF '$$DEVICE

               GOTO PRINT99

 +7        USE $PRINCIPAL

           IF IO=$PRINCIPAL

               DO FULL^VALM1

           USE IO

 +8        DO PRINTHDR

 +9        NEW A

           SET A=""

           FOR 

               SET A=$ORDER(IEN(A))

               IF A=""

                   QUIT 

               DO PRINTA(A)

PRINT9    ; joined here from PRINTALL,CLAIMLOG

 +1       ; this does DO ^%ZISC to close IO for you

           DO BYE^ABSPOSU5

PRINT99   ; joined here from PRINTALL,CLAIMLOG

 +1       ;PressAny^ABSPOSU5()

           DO ANY^ABSPOS2A

PRINT999  ;$S(VALMCC:"",1:"R")

           SET VALMBCK="R"

 +1        QUIT 

MAKERXI   ; IEN(*)=line numbers  we want to convert to prescription numbers

 +1       ; builds RXI(*)="" or maybe data, ignore whatever you get on right side

 +2        SET IEN=""

           FOR 

               SET IEN=$ORDER(IEN(IEN))

               IF IEN=""

                   QUIT 

               DO MRXI

 +3        QUIT 

MRXI       SET RXI=$PIECE(@DISPLINE@(IEN),U,2)

 +1       ; a prescription detail line; take just the one

           IF RXI

               SET RXI(RXI)=""

               QUIT 

 +2       ; else it's a patient line - take all of this patient's prescrip's

 +3        NEW PAT

           SET PAT=$PIECE(@DISPLINE@(IEN),U)

 +4       ; merge in all of the patient's prescriptions

           MERGE RXI=@DISP@(PAT)

 +5       ; with RXI(*) array set up

           QUIT 

CLAIMLOG  ; print a claim log  ABSB RXE POS RXE P1 CLAIM LOG

 +1        WRITE !,"Enter the line numbers for which you wish to print claim logs.",!

 +2       ; select prescription(s) or patients

           NEW IEN

           DO SELECPAT(.IEN)

 +3        IF $DATA(IEN)<10

               GOTO PRINT99

 +4        NEW IO

           IF '$$DEVICE

               GOTO PRINT99

 +5        USE $PRINCIPAL

           IF IO=$PRINCIPAL

               DO FULL^VALM1

           USE IO

 +6       ; IEN(*) -> converted to RXI(*)

           NEW RXI

           DO MAKERXI

 +7       ; now RXI(*) is the array of RXI's we want to print logs for

 +8        SET RXI=""

           FOR 

               SET RXI=$ORDER(RXI(RXI))

               IF RXI=""

                   QUIT 

               DO CLAIMLOG^ABSBPOS(RXI,IO)

 +9        DO BYE^ABSPOSU5

 +10       GOTO PRINT9

RECEIPT   ; print receipts

 +1        WRITE !,"Enter the line numbers for which you wish to print ",$$NAME^ABSPOS8(3),".",!

 +2       ; select prescription(s) or patients

           NEW IEN

           DO SELECPAT(.IEN)

 +3        IF $DATA(IEN)<10

               GOTO PRINT99

 +4        NEW IO

           IF '$$DEVICE

               GOTO PRINT99

 +5        USE $PRINCIPAL

           IF IO=$PRINCIPAL

               DO FULL^VALM1

 +6       ; IEN(*) -> converted to RXI(*)

           NEW RXI

           DO MAKERXI

 +7        DO RECEIPTS^ABSPOS8(.RXI,IO)

 +8        DO BYE^ABSPOSU5

 +9        GOTO PRINT9

REVERSE   ; reverse selected claims  ABSB RXE POS RXE P1 REVERSE

 +1        WRITE "Select the line(s) with the paid claim(s) you wish to REVERSE.",!

 +2       ; select which ones to reverse

           NEW IEN

           DO SELECPAT(.IEN)

 +3       ; IEN(*) -> converted to RXI(*)

           NEW RXI

           DO MAKERXI

 +4        DO FULL^VALM1

 +5        NEW REVTOTAL,REVELECT,ERRCOUNT

           SET (REVTOTAL,REVELECT,ERRCOUNT)=0

 +6        SET RXI=""

           FOR 

               SET RXI=$ORDER(RXI(RXI))

               IF RXI=""

                   QUIT 

               Begin DoDot:1

 +7                NEW X

                   SET X=$$REVERS59(RXI,0)

 +8                IF X

                       Begin DoDot:2

 +9                        SET REVTOTAL=REVTOTAL+1

 +10                       IF X>.5

                               SET REVELECT=REVELECT+1

                       End DoDot:2

 +11              IF '$TEST

                       Begin DoDot:2

 +12                       WRITE "Cannot reverse ",RXI,!

                           SET ERRCOUNT=ERRCOUNT+1

                       End DoDot:2

               End DoDot:1

 +13       WRITE REVTOTAL," claim reversal",$SELECT(REVTOTAL'=1:"s",1:"")," in progress.",!

 +14       IF ERRCOUNT

               Begin DoDot:1

 +15               WRITE "Some claim(s) could not be reversed because only paper claims",!

 +16               WRITE "and Payable electronic claims can be reversed.",!

               End DoDot:1

 +17      ; task up a packetizer

           IF REVELECT

               DO TASK^ABSPOSQ1

 +18      ;D PressAny^ABSPOSU5()

           DO ANY^ABSPOS2A

 +19       NEW NODISPLY

           SET NODISPLY=1

           DO UPD^ABSPOS6A

 +20       SET VALMBCK="R"

 +21      ;S VALMBCK=""

 +22       QUIT 

REVERS59(IEN59,WANTQ2) ; called here from ABSPOSRX too

 +1       ; IEN59 as usual; $G(WANT2Q)=TRUE if you want packetizer started

 +2       ; Returns 0 if no, no reversal, it's unreversable

 +3       ; Returns 0.5 if it's a paper claim that was reversed

 +4       ; Returns IEN of reversal claim if electronic claim submitted for

 +5       ;   reversal.

 +6        NEW RESULT

           SET RESULT=$$CATEG^ABSPOSB2(IEN59)

 +7        IF RESULT'="PAPER"

               IF RESULT'="E PAYABLE"

                   IF RESULT'="E DUPLICATE"

                       IF $QUIT

                           QUIT 0

                       QUIT 

 +8        IF RESULT="PAPER REVERSAL"!(RESULT="E REVERSAL ACCEPTED")

               IF $QUIT

                   QUIT 0

               QUIT 

 +9       ; Okay, reversal is permitted

 +10      ; bracket result text with [Previously: ]

           DO PREVISLY^ABSPOSIZ(IEN59)

 +11       IF RESULT="PAPER"

               DO REVERSP(IEN59)

               IF $QUIT

                   QUIT 0.5

               QUIT 

 +12      ; Here, reversal of electronic claim:

 +13      ; the claim

           NEW CLAIMIEN

           SET CLAIMIEN=$PIECE(^ABSPEC(9002335.59,IEN59,0),U,4)

 +14      ; and position therein

           NEW POS

           SET POS=$PIECE(^ABSPEC(9002335.59,IEN59,0),U,9)

 +15      ; construct reversal

           NEW REV

           SET REV=$$REVERSE^ABSPECA8(CLAIMIEN,POS)

 +16      ;S $P(^ABSPEC(9002335.59,IEN59,4),U)=REV ; mark claim with reversal

           Begin DoDot:1

 +17           NEW DIE,DR,DA

               SET DIE=9002335.59

               SET DA=IEN59

               SET DR="401////"_REV

               DO ^DIE

           End DoDot:1

 +18      ; waiting to packetize

           NEW ABSBRXI

           SET ABSBRXI=IEN59

           DO SETSTAT^ABSBPOSR(30)

 +19       IF $GET(WANT2Q)

               DO TASK^ABSPOSQ1

 +20       IF $QUIT

               QUIT REV

           QUIT 

REVERSP(IEN59) ; reverse the given paper claim

 +1        NEW ABSBRXI,OLDSLOT,X,MSG

           SET MSG="Reversed paper claim"

 +2        SET $PIECE(^ABSPEC(9002335.59,IEN59,4),U,3)=1

 +3        SET ABSBRXI=IEN59

           DO SETSTAT^ABSBPOSR(99)

 +4        DO SETRESU^ABSBPOSR(1,MSG)

 +5        SET OLDSLOT=$$GETSLOT^ABSBPOSU

 +6        DO INIT^ABSBPOSU(IEN59,1)

 +7        DO LOG^ABSBPOSU(MSG)

 +8        DO RELSLOT^ABSBPOSU

 +9        IF OLDSLOT

               DO SETSLOT^ABSBPOSU(OLDSLOT)

 +10       QUIT 

RESUBMIT  ;

 +1        WRITE "Select the line(s) with the claim(s) you wish to RESUBMIT.",!

 +2       ; gives IEN(*)

           NEW IEN

           DO SELECPAT(.IEN)

 +3       ; IEN(*) -> converted to RXI(*)

           NEW RXI

           DO MAKERXI

 +4        DO FULL^VALM1

 +5        NEW REVCOUNT

           SET REVCOUNT=0

 +6        NEW IEN59

           SET IEN59=""

           FOR 

               SET IEN59=$ORDER(RXI(IEN59))

               IF IEN59=""

                   QUIT 

               Begin DoDot:1

 +7                NEW X

                   SET X=$$RESULT59^ABSPOSRX(IEN59)

 +8                IF X="E PAYABLE"!(X="E DUPLICATE")!(X="E REVERSAL REJECTED")

                       Begin DoDot:2

 +9                        WRITE "`",IEN59," is Payable; you must REVERSE it first.",!

                       End DoDot:2

                       QUIT 

 +10               IF X="PAPER"

                       Begin DoDot:2

 +11                       WRITE "`",IEN59," is a paper claim; it will be implicitly reversed",!

                       End DoDot:2

 +12               DO RESUB1(IEN59)

 +13               DO PREVISLY^ABSPOSIZ(IEN59)

 +14               WRITE "Resubmitted `",IEN59,!

                   HANG 1

               End DoDot:1

 +15      ; task up a "gathering claim info" job

           DO TASK^ABSPOSIZ

 +16      ;D PressAny^ABSPOSU5()

           DO ANY^ABSPOS2A

 +17       NEW NODISPLY

           SET NODISPLY=1

           DO UPD^ABSPOS6A

 +18       SET VALMBCK="R"

 +19       QUIT 

RESUB1(IEN59) ; resubmit one entry in .59 ; caller responsible for

 +1       ; starting up  D TASK^ABSPOSIZ

 +2       ; Also called here from ABSBPOSR, for reverse-and-resubmit action

 +3       ;Kill pointers of previous submissions and reversals

 +4        NEW DIE,DR,DA

           SET DIE=9002335.59

           SET DA=IEN59

 +5        SET DR=""

           NEW I

           FOR I=3,4,401:1:403,301:1:302,801:1:803

               Begin DoDot:1

 +6                IF DR]""

                       SET DR=DR_";"

                   SET DR=DR_I_"///@"

               End DoDot:1

 +7        DO ^DIE

 +8       ;D PREVISLY^ABSPOSIZ(IEN59) ; bracket result text with "[Previously: ]"

 +9       ; Reset status

 +10       NEW ABSBRXI

           SET ABSBRXI=IEN59

           DO SETSTAT^ABSBPOSR(0)

 +11       QUIT 

DEVICE()  ; device selection for POS

 +1       ; want to provide a convenient default

 +2        NEW DEFAULT

           SET DEFAULT="HOME"

 +3        NEW DEVICE

           SET DEVICE=$$DEVICE^ABSPOSU8(DEFAULT)

 +4        IF 'DEVICE

               QUIT ""

 +5        QUIT DEVICE

CANCEL    ; cancel a claim  ABSB POS RXE P1 CANCEL CLAIM

 +1        NEW LINE

 +2        WRITE !,"Select prescription to cancel by line number.  Hurry!"

 +3        DO SELECPAT(.LINE)

 +4        IF $ORDER(LINE(""))=""

               WRITE !,"None selected for cancellation",!

               GOTO CAN99

 +5        IF 0

               DO FULL^VALM1

               WRITE "Temporary for debugging:",!

               Begin DoDot:1

 +6 

*** ERROR ***

 +7                NEW TMP

                   MERGE TMP=@DISP