ABSPOSAN.m

ABSPOSAN ; IHS/FCS/DRS - Cancellation ;   [ 09/12/2002  10:05 AM ]

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

 Q

 ;

 ; CANCEL:  See any of CLAIMIEN's claims have been marked for

 ;   cancellation.  If so, we don't want to send the claim.

 ;  Called from GETNEXT^ABSPOSAP.

 ;

CANCEL() ;EP - Deal with Cancellations in CLAIMIEN

 N RXI,CXL,KEEP S RXI="",(CXL,KEEP)=0

 N OLDSLOT S OLDSLOT=$$GETSLOT^ABSPOSL

 F  S RXI=$O(^ABSPT("AE",CLAIMIEN,RXI)) Q:RXI=""  D

 .I $G(^ABSPT(RXI,3)) S CXL=CXL+1 Q

 I 'CXL Q 0  ; none being canceled

 ; At least one being canceled

 ; The canceled one gets stamped as finished

 ; The others get sent back to status 30, Waiting for packet build

 S RXI="" F  S RXI=$O(^ABSPT("AE",CLAIMIEN,RXI)) Q:RXI=""  D

 .N ABSBRXI S ABSBRXI=RXI ; as some called subroutines expect it

 .D SETSLOT^ABSPOSL(ABSBRXI)

 .I $G(^ABSPT(RXI,3)) D

 ..D DOCANCEL(RXI) ; cancel this claim

 .E  D  ; send this claim back to status 30

 ..S KEEP=KEEP+1

 ..D SETSTAT^ABSPOSU(30)

 ..D LOG(CXL_" claim"_$S(CXL>1:"s",1:"")_" in the transmit packet were canceled; this claim was requeued.")

 ; Finally, rev up a packeter to make sure that any surviving claims

 ; get another chance

 I KEEP D PACKETER^ABSPOSQ1 ; ensure surviving claims get repacketed

 D SETSLOT^ABSPOSL(OLDSLOT)

 Q CXL

 ;

 ;

DOCANCEL(IEN59) ; actually do the cancellation

 ; This may be called from other places.

 N BYDUZ S BYDUZ=$P(^ABSPT(IEN59,3),U)

 N MSG S MSG=RXI_" CANCELED by "_DUZ_" "_$P($G(^VA(200,BYDUZ,0)),U)

 N OLDSLOT S OLDSLOT=$$GETSLOT^ABSPOSL

 D SETSLOT^ABSPOSL(IEN59)

 D LOG(MSG)

 D RELSLOT^ABSPOSL

 I OLDSLOT D SETSLOT^ABSPOSL(OLDSLOT)

 ; In field 302, put the status of the claim at the time it was canceled

 ; Test:  I field 302 ]"", then the claim was successfully canceled.

 S $P(^ABSPT(IEN59,3),U,2)=$P(^ABSPT(IEN59,0),U,2)

 D SETSTAT^ABSPOSU(99)

 D SETRESU^ABSPOSU(-1,MSG)

 Q

LOG(X) D LOG^ABSPOSL($T(+0)_" - "_X) Q

ABSPOSAN  ; IHS/FCS/DRS - Cancellation ;   [ 09/12/2002  10:05 AM ]

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

 +2        QUIT 

 +3       ;

 +4       ; CANCEL:  See any of CLAIMIEN's claims have been marked for

 +5       ;   cancellation.  If so, we don't want to send the claim.

 +6       ;  Called from GETNEXT^ABSPOSAP.

 +7       ;

CANCEL()  ;EP - Deal with Cancellations in CLAIMIEN

 +1        NEW RXI,CXL,KEEP

           SET RXI=""

           SET (CXL,KEEP)=0

 +2        NEW OLDSLOT

           SET OLDSLOT=$$GETSLOT^ABSPOSL

 +3        FOR 

               SET RXI=$ORDER(^ABSPT("AE",CLAIMIEN,RXI))

               IF RXI=""

                   QUIT 

               Begin DoDot:1

 +4                IF $GET(^ABSPT(RXI,3))

                       SET CXL=CXL+1

                       QUIT 

               End DoDot:1

 +5       ; none being canceled

           IF 'CXL

               QUIT 0

 +6       ; At least one being canceled

 +7       ; The canceled one gets stamped as finished

 +8       ; The others get sent back to status 30, Waiting for packet build

 +9        SET RXI=""

           FOR 

               SET RXI=$ORDER(^ABSPT("AE",CLAIMIEN,RXI))

               IF RXI=""

                   QUIT 

               Begin DoDot:1

 +10      ; as some called subroutines expect it

                   NEW ABSBRXI

                   SET ABSBRXI=RXI

 +11               DO SETSLOT^ABSPOSL(ABSBRXI)

 +12               IF $GET(^ABSPT(RXI,3))

                       Begin DoDot:2

 +13      ; cancel this claim

                           DO DOCANCEL(RXI)

                       End DoDot:2

 +14      ; send this claim back to status 30

                  IF '$TEST

                       Begin DoDot:2

 +15                       SET KEEP=KEEP+1

 +16                       DO SETSTAT^ABSPOSU(30)

 +17                       DO LOG(CXL_" claim"_$SELECT(CXL>1:"s",1:"")_" in the transmit packet were canceled; this claim was requeued.")

                       End DoDot:2

               End DoDot:1

 +18      ; Finally, rev up a packeter to make sure that any surviving claims

 +19      ; get another chance

 +20      ; ensure surviving claims get repacketed

           IF KEEP

               DO PACKETER^ABSPOSQ1

 +21       DO SETSLOT^ABSPOSL(OLDSLOT)

 +22       QUIT CXL

 +23      ;

 +24      ;

DOCANCEL(IEN59) ; actually do the cancellation

 +1       ; This may be called from other places.

 +2        NEW BYDUZ

           SET BYDUZ=$PIECE(^ABSPT(IEN59,3),U)

 +3        NEW MSG

           SET MSG=RXI_" CANCELED by "_DUZ_" "_$PIECE($GET(^VA(200,BYDUZ,0)),U)

 +4        NEW OLDSLOT

           SET OLDSLOT=$$GETSLOT^ABSPOSL

 +5        DO SETSLOT^ABSPOSL(IEN59)

 +6        DO LOG(MSG)

 +7        DO RELSLOT^ABSPOSL

 +8        IF OLDSLOT

               DO SETSLOT^ABSPOSL(OLDSLOT)

 +9       ; In field 302, put the status of the claim at the time it was canceled

 +10      ; Test:  I field 302 ]"", then the claim was successfully canceled.

 +11       SET $PIECE(^ABSPT(IEN59,3),U,2)=$PIECE(^ABSPT(IEN59,0),U,2)

 +12       DO SETSTAT^ABSPOSU(99)

 +13       DO SETRESU^ABSPOSU(-1,MSG)

 +14       QUIT 

LOG(X)     DO LOG^ABSPOSL($TEXT(+0)_" - "_X)

           QUIT