ABSPOS6D.m

ABSPOS6D ; IHS/FCS/DRS - user screen subrous ;   

 ;;1.0;PHARMACY POINT OF SALE;**14,18,37,38,40,41,46**;JUN 21, 2001;Build 38

 ;----------------------------------------------------------------------

 ;IHS/SD/RLT - 8/24/06 - Patch 18

 ;  Changed code so rejected reversals can be resubmitted.

 Q

PRINTALL ; protocol ABSP P1 PRINT ALL ; print all patients' results

 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")," "

 N %,%H,%I,X,Y D NOW^%DTC S Y=% X ^DD("DD") W Y,!!

 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 ; protocol ABSP P1 PRINT PATIENT ; print a patient's results

 ; 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 ; protocol ABSP 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^ABSPOS6M(RXI,IO)

 ;D BYE^ABSPOSU5

 G PRINT9

RECEIPT ; protocol ABSP P1 RECEIPT ; print receipts

 W !,"Enter the line numbers for which you wish to print ",$$NAME^ABSPOS6E(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^ABSPOS6E(.RXI,IO)

 D BYE^ABSPOSU5

 G PRINT9

REVERSE ; protocol ABSP P1 REVERSE CLAIM ; reverse selected claims

 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)    ;EP - called here from ABSPOSRB 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 OLDSLOT S OLDSLOT=$$GETSLOT^ABSPOSL

 D SETSLOT^ABSPOSL(IEN59)

 D LOG^ABSPOSL("Reversal - begin")

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

 ;IHS/SD/RLT - 8/24/06 - Patch 18 - begin

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

 ;IHS/OIT/CASSEVERN/RAN - 02/07/2011 - Patch 41 - Allow "E CAPTURED" to be reversed.

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

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

 ;IHS/SD/RLT - 8/24/06 - Patch 18 - end

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

 ; Okay, reversal is permitted

 D  ; stamp new starting time

 . N DIE,DR,DA S DIE=9002313.59,DA=IEN59,DR="15///NOW;7///NOW" D ^DIE

 D LOG59A^ABSPOSQB ; and log contents of 9002313.59

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

 I RESULT="PAPER" D  Q:$Q 0.5 Q

 . D REVERSP(IEN59) ; reverse the paper claim

 . D RELSLOT^ABSPOSL,SETSLOT^ABSPOSL(OLDSLOT)

 ; Here, reversal of electronic claim:

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

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

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

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

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

 D LOG^ABSPOSL("Reversal claim `"_REV_" "_$P(^ABSPC(REV,0),U))

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

 I $G(WANTQ2) D TASK^ABSPOSQ1

 D RELSLOT^ABSPOSL,SETSLOT^ABSPOSL(OLDSLOT)

 Q:$Q REV Q

REVERSP(IEN59)     ; reverse the given paper claim

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

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

 S ABSBRXI=IEN59

 D SETRESU^ABSPOSU(1,MSG)

 D LOG59^ABSPOSL(MSG,IEN59)

 D SETSTAT^ABSPOSU(99)

 Q

RESUBMIT ; protocol ABSP P1 RESUBMIT ; resubmit a claim shown on your screen

 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

 ;

 ;OIT/CAS/RCS 081913 Patch 46 If claim is paid ask if ok to resubmit,delete from list if not

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

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

 .I X="E PAYABLE" D  Q

 ..W ! S DIR(0)="Y",DIR("A")="`"_IEN59_" has been paid, do you wish to Resubmit",DIR("B")="NO" D ^DIR K DIR

 ..W ! I 'Y K RXI(IEN59)

 ;

 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)

 .;IHS/OIT/CASSEVERN/RAN - 02/07/2011 - Patch 41 - Add "E CAPTURED" to types to be reversed.

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

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

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

 ..W "`",IEN59," will be REVERSED first, then Resubmitted.",!

 ..S $P(^ABSPT(IEN59,1),U,12)=1

 ..D REVERS59(IEN59,1)

 .I X="PAPER" D  Q

 ..W "`",IEN59," will be REVERSED first, then Resubmitted.",!

 ..S $P(^ABSPT(IEN59,1),U,12)=1

 ..D REVERS59(IEN59)

 .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,MIN)        ;EP - from ABSPOSU

 ; resubmit one entry in .59 ; caller responsible for

 ; starting up  D TASK^ABSPOSIZ

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

 ;Kill pointers of previous submissions and reversals

 N DIE,DR,DA S DIE=9002313.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_"///@"

 . S DR=DR_";15///NOW;7///NOW" ; stamp new starting time, too

 ;S DR=DR_";6///"_DUZ ;IHS/OIT/CNI/SCR 033010 - update 'Updated By User' for CPR report patch 38

 S DR=DR_";6///`"_DUZ ;IHS/OIT/CNI/RAN 091710 - corrected 'Updated By User' input to properly use INTERNAL value patch 40

 I '$G(MIN) D  ; ABSP*1.0T7*11 this whole block

 . F I=10,11,1.05:.01:1.08,1.13,601:1:603,701:1:703 S DR=DR_";"_I_"///@"

 . ;IHS/OIT/SCR 11/20/08 delete new 'incentive amount submitted' field also

 . ;I '$P($G(^ABSPT(DA,5)),U,6) F I=501:1:505 S DR=DR_";"_I_"///@"

 . I '$P($G(^ABSPT(DA,5)),U,6) F I=501,502,503,505,507 S DR=DR_";"_I_"///@"

 D ^DIE

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

 ; Reset status

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

 Q

DEVICE() ;EP - 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 ; protocol ABSP 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

 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^ABSPOS6L 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^ABSPOS6L

 W !,"Cancellation requests made." H 1

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

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

 Q

DISMISS ; protocol ABSP P1 DISMISS ; dismiss a patient from my screen

 ; 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^ABSPOSUD(%,^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

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

CLOSECLM  ;protocol ABSP P1 CLOSE CLAIM

 ;IHS/OIT/SCR 021910 patch 37

 N ABSPIEN,X,%,%I,%H,ABSPDFN,ABSPCLSD,IEN,ABSPTIME

 D NOW^%DTC

 S ABSPTIME=%

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

 D SELECPAT(.IEN) ; select prescription(s) or patients - IEN is expected to be defined

 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=""  S ABSPCLSD=$$CLOSECLM^ABSPOS6N(RXI)

 D ANY^ABSPOS2A

 ;D CLEAN^VALM10

 D EN^ABSPOS6A(DUZ,ABSPTIME)

 ;S VALMBCK="R"

 Q

OPENCLM  ;Protocol ABSP P1 RE-OPEN CLAIM

 ;IHS/OIT/SCR 021910 patch 37

 N ABSPOPEN

 D FULL^VALM1

 S ABSPOPEN=$$OPENCLM^ABSPOS6N

 D ANY^ABSPOS2A

 N NODISPLY S NODISPLY=1 D UPD^ABSPOS6A

 S VALMBCK="R"

 Q

ABSPOS6D  ; IHS/FCS/DRS - user screen subrous ;   

 +1       ;;1.0;PHARMACY POINT OF SALE;**14,18,37,38,40,41,46**;JUN 21, 2001;Build 38

 +2       ;----------------------------------------------------------------------

 +3       ;IHS/SD/RLT - 8/24/06 - Patch 18

 +4       ;  Changed code so rejected reversals can be resubmitted.

 +5        QUIT 

PRINTALL  ; protocol ABSP P1 PRINT ALL ; print all patients' results

 +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")," "

 +2        NEW %,%H,%I,X,Y

           DO NOW^%DTC

           SET Y=%

           XECUTE ^DD("DD")

           WRITE Y,!!

 +3        NEW A

           SET A=""

           FOR 

               SET A=$ORDER(VALMHDR(A))

               IF A=""

                   QUIT 

               WRITE VALMHDR(A),!

 +4        WRITE !

 +5        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     ; protocol ABSP P1 PRINT PATIENT ; print a patient's results

 +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  ; protocol ABSP 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^ABSPOS6M(RXI,IO)

 +9       ;D BYE^ABSPOSU5

 +10       GOTO PRINT9

RECEIPT   ; protocol ABSP P1 RECEIPT ; print receipts

 +1        WRITE !,"Enter the line numbers for which you wish to print ",$$NAME^ABSPOS6E(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^ABSPOS6E(.RXI,IO)

 +8        DO BYE^ABSPOSU5

 +9        GOTO PRINT9

REVERSE   ; protocol ABSP P1 REVERSE CLAIM ; reverse selected claims

 +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) ;EP - called here from ABSPOSRB 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 OLDSLOT

           SET OLDSLOT=$$GETSLOT^ABSPOSL

 +7        DO SETSLOT^ABSPOSL(IEN59)

 +8        DO LOG^ABSPOSL("Reversal - begin")

 +9        NEW RESULT

           SET RESULT=$$CATEG^ABSPOSUC(IEN59)

 +10      ;IHS/SD/RLT - 8/24/06 - Patch 18 - begin

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

 +12      ;IHS/OIT/CASSEVERN/RAN - 02/07/2011 - Patch 41 - Allow "E CAPTURED" to be reversed.

 +13      ;I RESULT'="PAPER",RESULT'="E PAYABLE",RESULT'="E DUPLICATE",RESULT'="E REVERSAL REJECTED" Q:$Q 0 Q

 +14       IF RESULT'="PAPER"

               IF RESULT'="E PAYABLE"

                   IF RESULT'="E DUPLICATE"

                       IF RESULT'="E REVERSAL REJECTED"

                           IF RESULT'="E CAPTURED"

                               IF $QUIT

                                   QUIT 0

                               QUIT 

 +15      ;IHS/SD/RLT - 8/24/06 - Patch 18 - end

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

               IF $QUIT

                   QUIT 0

               QUIT 

 +17      ; Okay, reversal is permitted

 +18      ; stamp new starting time

           Begin DoDot:1

 +19           NEW DIE,DR,DA

               SET DIE=9002313.59

               SET DA=IEN59

               SET DR="15///NOW;7///NOW"

               DO ^DIE

           End DoDot:1

 +20      ; and log contents of 9002313.59

           DO LOG59A^ABSPOSQB

 +21      ; bracket result text with [Previously: ]

           DO PREVISLY^ABSPOSIZ(IEN59)

 +22       IF RESULT="PAPER"

               Begin DoDot:1

 +23      ; reverse the paper claim

                   DO REVERSP(IEN59)

 +24               DO RELSLOT^ABSPOSL

                   DO SETSLOT^ABSPOSL(OLDSLOT)

               End DoDot:1

               IF $QUIT

                   QUIT 0.5

               QUIT 

 +25      ; Here, reversal of electronic claim:

 +26      ; the claim

           NEW CLAIMIEN

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

 +27      ; and position therein

           NEW POS

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

 +28      ; construct reversal

           NEW REV

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

 +29      ;S $P(^ABSPT(IEN59,4),U)=REV ; mark claim with reversal

           Begin DoDot:1

 +30           NEW DIE,DR,DA

               SET DIE=9002313.59

               SET DA=IEN59

               SET DR="401////"_REV

               DO ^DIE

           End DoDot:1

 +31       DO LOG^ABSPOSL("Reversal claim `"_REV_" "_$PIECE(^ABSPC(REV,0),U))

 +32      ; waiting to packetize

           NEW ABSBRXI

           SET ABSBRXI=IEN59

           DO SETSTAT^ABSPOSU(30)

 +33       IF $GET(WANTQ2)

               DO TASK^ABSPOSQ1

 +34       DO RELSLOT^ABSPOSL

           DO SETSLOT^ABSPOSL(OLDSLOT)

 +35       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(^ABSPT(IEN59,4),U,3)=1

 +3        SET ABSBRXI=IEN59

 +4        DO SETRESU^ABSPOSU(1,MSG)

 +5        DO LOG59^ABSPOSL(MSG,IEN59)

 +6        DO SETSTAT^ABSPOSU(99)

 +7        QUIT 

RESUBMIT  ; protocol ABSP P1 RESUBMIT ; resubmit a claim shown on your screen

 +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       ;

 +6       ;OIT/CAS/RCS 081913 Patch 46 If claim is paid ask if ok to resubmit,delete from list if not

 +7        NEW IEN59

           SET IEN59=""

           FOR 

               SET IEN59=$ORDER(RXI(IEN59))

               IF IEN59=""

                   QUIT 

               Begin DoDot:1

 +8                NEW X

                   SET X=$$RESULT59^ABSPOSRX(IEN59)

 +9                IF X="E PAYABLE"

                       Begin DoDot:2

 +10                       WRITE !

                           SET DIR(0)="Y"

                           SET DIR("A")="`"_IEN59_" has been paid, do you wish to Resubmit"

                           SET DIR("B")="NO"

                           DO ^DIR

                           KILL DIR

 +11                       WRITE !

                           IF 'Y

                               KILL RXI(IEN59)

                       End DoDot:2

                       QUIT 

               End DoDot:1

 +12      ;

 +13       NEW REVCOUNT

           SET REVCOUNT=0

 +14       NEW IEN59

           SET IEN59=""

           FOR 

               SET IEN59=$ORDER(RXI(IEN59))

               IF IEN59=""

                   QUIT 

               Begin DoDot:1

 +15               NEW X

                   SET X=$$RESULT59^ABSPOSRX(IEN59)

 +16      ;IHS/OIT/CASSEVERN/RAN - 02/07/2011 - Patch 41 - Add "E CAPTURED" to types to be reversed.

 +17      ;I X="E PAYABLE"!(X="E DUPLICATE")!(X="E REVERSAL REJECTED") D  Q

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

                       Begin DoDot:2

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

 +20                       WRITE "`",IEN59," will be REVERSED first, then Resubmitted.",!

 +21                       SET $PIECE(^ABSPT(IEN59,1),U,12)=1

 +22                       DO REVERS59(IEN59,1)

                       End DoDot:2

                       QUIT 

 +23               IF X="PAPER"

                       Begin DoDot:2

 +24                       WRITE "`",IEN59," will be REVERSED first, then Resubmitted.",!

 +25                       SET $PIECE(^ABSPT(IEN59,1),U,12)=1

 +26                       DO REVERS59(IEN59)

                       End DoDot:2

                       QUIT 

 +27               DO RESUB1(IEN59)

 +28      ;D PREVISLY^ABSPOSIZ(IEN59)

 +29               WRITE "Resubmitted `",IEN59,!

                   HANG 1

               End DoDot:1

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

           DO TASK^ABSPOSIZ

 +31      ;D PRESSANY^ABSPOSU5()

           DO ANY^ABSPOS2A

 +32       NEW NODISPLY

           SET NODISPLY=1

           DO UPD^ABSPOS6A

 +33       SET VALMBCK="R"

 +34       QUIT 

RESUB1(IEN59,MIN) ;EP - from ABSPOSU

 +1       ; resubmit one entry in .59 ; caller responsible for

 +2       ; starting up  D TASK^ABSPOSIZ

 +3       ; Also called here from ABSPOSU, for reverse-and-resubmit action

 +4       ;Kill pointers of previous submissions and reversals

 +5        NEW DIE,DR,DA

           SET DIE=9002313.59

           SET DA=IEN59

 +6        SET DR=""

           NEW I

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

               Begin DoDot:1

 +7                IF DR]""

                       SET DR=DR_";"

                   SET DR=DR_I_"///@"

 +8       ; stamp new starting time, too

                   SET DR=DR_";15///NOW;7///NOW"

               End DoDot:1

 +9       ;S DR=DR_";6///"_DUZ ;IHS/OIT/CNI/SCR 033010 - update 'Updated By User' for CPR report patch 38

 +10      ;IHS/OIT/CNI/RAN 091710 - corrected 'Updated By User' input to properly use INTERNAL value patch 40

           SET DR=DR_";6///`"_DUZ

 +11      ; ABSP*1.0T7*11 this whole block

           IF '$GET(MIN)

               Begin DoDot:1

 +12               FOR I=10,11,1.05:.01:1.08,1.13,601:1:603,701:1:703

                       SET DR=DR_";"_I_"///@"

 +13      ;IHS/OIT/SCR 11/20/08 delete new 'incentive amount submitted' field also

 +14      ;I '$P($G(^ABSPT(DA,5)),U,6) F I=501:1:505 S DR=DR_";"_I_"///@"

 +15               IF '$PIECE($GET(^ABSPT(DA,5)),U,6)

                       FOR I=501,502,503,505,507

                           SET DR=DR_";"_I_"///@"

               End DoDot:1

 +16       DO ^DIE

 +17      ; bracket result text with "[Previously: ]"

           DO PREVISLY^ABSPOSIZ(IEN59)

 +18      ; Reset status

 +19       NEW ABSBRXI

           SET ABSBRXI=IEN59

           DO SETSTAT^ABSPOSU(0)

 +20       QUIT 

DEVICE()  ;EP - 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    ; protocol ABSP 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        SET LINE=""

           FOR 

               SET LINE=$ORDER(LINE(LINE))

               IF LINE=""

                   QUIT 

               Begin DoDot:1

 +6                NEW PAT,RXI

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

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

 +7                IF RXI

                       DO CANC5^ABSPOS6L

                       QUIT 

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

 +9                SET RXI=""

                   FOR 

                       SET RXI=$ORDER(@DISP@(PAT,RXI))

                       IF RXI=""

                           QUIT 

                       DO CANC5^ABSPOS6L

               End DoDot:1

 +10       WRITE !,"Cancellation requests made."

           HANG 1

CAN99     ;D PRESSANY^ABSPOSU5()

           DO ANY^ABSPOS2A

 +1        NEW NODISPLY

           DO UPD^ABSPOS6A

           SET VALMBCK="R"

 +2        QUIT 

DISMISS   ; protocol ABSP P1 DISMISS ; dismiss a patient from my screen

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

 +2       ; time window has expired.  Do it by:

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

 +4       ;    the patient and prescription off our screen until then.

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

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

 +7       ; This functionality is provided with the intent to support

 +8       ; dismissing an entire patient's record after all processing

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

 +10      ; you presume it might have.

DIS0       NEW IEN,TIME,X,%,%I,%H

           DO NOW^%DTC

 +1        SET TIME=$$TADD^ABSPOSUD(%,^TMP("ABSPOS",$JOB,"TIME"))

 +2        DO SELECPAT(.IEN)

 +3        SET IEN=""

           FOR 

               SET IEN=$ORDER(IEN(IEN))

               IF IEN=""

                   QUIT 

               Begin DoDot:1

 +4                NEW PAT,RXI