IBARXEC4.m

IBARXEC4 ;ALB/AAS - RX COPAY EXEMPTION CONVERSION REPORT BUILD ; 14-JAN-93

 ;;2.0; INTEGRATED BILLING ;**78**; 21-MAR-94

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

% ;

BUILD ; -- Build report

 ;

 N IBERR S (IBERR,IBOK,IBN)=0

 F  S IBN=$O(^IB("AC",11,IBN)) Q:'IBN  D CHK,SET:IBOK

 D:IBERR>0 ERRMSG Q

 ;

CHK ; -- is entry in date range

 S IBOK=0

 S X=$G(^IB(IBN,0)),X1=$G(^IB(IBN,1))

 I X=""!(X1="") S IBERR=IBERR+1,IBERR(IBN)="" Q

 I (IBBDT-.00001)<$P(X1,"^",2),(IBEDT+.9)>$P(X1,"^",2) S IBOK=1

CHKQ Q

 ;

SET ; -- set entry in ^tmp

 S DFN=$P(X,"^",2)

 S IBP=$$PT^IBEFUNC(DFN) ; name^bid^pid

 S ^TMP("IBCONV",$J,$P(IBP,"^"),DFN,IBN)=IBP

 Q

 ;

ERRMSG ; -- transmits error message

 N XMDUZ,XMSUB,XMTEXT,XMY,X0,X1,X2 K ^TMP("IBERR",$J)

 S ^TMP("IBERR",$J,1)="The Print Charges Canceled Due to Income Exemption option ran into"

 S ^TMP("IBERR",$J,2)="a possible data corruption problem in the INTEGRATED BILLING ACTION"

 S ^TMP("IBERR",$J,3)="file during its run. The option has encountered "_IBERR_" '^IB(""AC"",11' cross"

 S ^TMP("IBERR",$J,4)="reference entr"_$S(IBERR>1:"ies",1:"y")_" for which there "_$S(IBERR>1:"were",1:"was")_" no corresponding 0 or 1 node"_$S(IBERR>1:"s",1:"")_" in the"

 S ^TMP("IBERR",$J,5)="file's global. The file internal entry number"_$S(IBERR>1:"s",1:"")_" (IEN"_$S(IBERR>1:"s",1:"")_") for the missing"

 S ^TMP("IBERR",$J,6)="node"_$S(IBERR>1:"s are",1:" is")_" the following:",^TMP("IBERR",$J,7)="",^TMP("IBERR",$J,8)="     "

 S (X0,X1)=0,X2=8 F  S X0=$O(IBERR(X0)) Q:X0=""  D

 .S ^TMP("IBERR",$J,X2)=^TMP("IBERR",$J,X2)_$J(X0,7)_"   ",X1=X1+1

 .I X1=6,+$O(IBERR(X0))>0 S X1=0,X2=X2+1,^TMP("IBERR",$J,X2)="     "

 S ^TMP("IBERR",$J,(X2+1))="",^TMP("IBERR",$J,(X2+2))="Please notify your IRM service of this so that they can check this"

 S ^TMP("IBERR",$J,(X2+3))="file and make the appropriate fixes. The report will still print out,"

 S ^TMP("IBERR",$J,(X2+4))="but it may not have all the data you requested. Thank you."

 S XMSUB="**WARNING** POSSIBLE FILE ERROR",XMTEXT="^TMP(""IBERR"",$J,"

 S XMDUZ=.5,XMY("G.IB ERROR")="" D ^XMD K ^TMP("IBERR",$J) Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBARXEC4   2153     printed  Apr 09, 2024@21:21:08                                                                                                                                                                                                    Page 2

IBARXEC4  ;ALB/AAS - RX COPAY EXEMPTION CONVERSION REPORT BUILD ; 14-JAN-93

 +1       ;;2.0; INTEGRATED BILLING ;**78**; 21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

%         ;

BUILD     ; -- Build report

 +1       ;

 +2        NEW IBERR

           SET (IBERR,IBOK,IBN)=0

 +3        FOR 

               SET IBN=$ORDER(^IB("AC",11,IBN))

               if 'IBN

                   QUIT 

               DO CHK

               if IBOK

                   DO SET

 +4        if IBERR>0

               DO ERRMSG

           QUIT 

 +5       ;

CHK       ; -- is entry in date range

 +1        SET IBOK=0

 +2        SET X=$GET(^IB(IBN,0))

           SET X1=$GET(^IB(IBN,1))

 +3        IF X=""!(X1="")

               SET IBERR=IBERR+1

               SET IBERR(IBN)=""

               QUIT 

 +4        IF (IBBDT-.00001)<$PIECE(X1,"^",2)

               IF (IBEDT+.9)>$PIECE(X1,"^",2)

                   SET IBOK=1

CHKQ       QUIT 

 +1       ;

SET       ; -- set entry in ^tmp

 +1        SET DFN=$PIECE(X,"^",2)

 +2       ; name^bid^pid

           SET IBP=$$PT^IBEFUNC(DFN)

 +3        SET ^TMP("IBCONV",$JOB,$PIECE(IBP,"^"),DFN,IBN)=IBP

 +4        QUIT 

 +5       ;

ERRMSG    ; -- transmits error message

 +1        NEW XMDUZ,XMSUB,XMTEXT,XMY,X0,X1,X2

           KILL ^TMP("IBERR",$JOB)

 +2        SET ^TMP("IBERR",$JOB,1)="The Print Charges Canceled Due to Income Exemption option ran into"

 +3        SET ^TMP("IBERR",$JOB,2)="a possible data corruption problem in the INTEGRATED BILLING ACTION"

 +4        SET ^TMP("IBERR",$JOB,3)="file during its run. The option has encountered "_IBERR_" '^IB(""AC"",11' cross"

 +5        SET ^TMP("IBERR",$JOB,4)="reference entr"_$SELECT(IBERR>1:"ies",1:"y")_" for which there "_$SELECT(IBERR>1:"were",1:"was")_" no corresponding 0 or 1 node"_$SELECT(IBERR>1:"s",1:"")_" in the"

 +6        SET ^TMP("IBERR",$JOB,5)="file's global. The file internal entry number"_$SELECT(IBERR>1:"s",1:"")_" (IEN"_$SELECT(IBERR>1:"s",1:"")_") for the missing"

 +7        SET ^TMP("IBERR",$JOB,6)="node"_$SELECT(IBERR>1:"s are",1:" is")_" the following:"

           SET ^TMP("IBERR",$JOB,7)=""

           SET ^TMP("IBERR",$JOB,8)="     "

 +8        SET (X0,X1)=0

           SET X2=8

           FOR 

               SET X0=$ORDER(IBERR(X0))

               if X0=""

                   QUIT 

               Begin DoDot:1

 +9                SET ^TMP("IBERR",$JOB,X2)=^TMP("IBERR",$JOB,X2)_$JUSTIFY(X0,7)_"   "

                   SET X1=X1+1

 +10               IF X1=6

                       IF +$ORDER(IBERR(X0))>0

                           SET X1=0

                           SET X2=X2+1

                           SET ^TMP("IBERR",$JOB,X2)="     "

               End DoDot:1

 +11       SET ^TMP("IBERR",$JOB,(X2+1))=""

           SET ^TMP("IBERR",$JOB,(X2+2))="Please notify your IRM service of this so that they can check this"

 +12       SET ^TMP("IBERR",$JOB,(X2+3))="file and make the appropriate fixes. The report will still print out,"

 +13       SET ^TMP("IBERR",$JOB,(X2+4))="but it may not have all the data you requested. Thank you."

 +14       SET XMSUB="**WARNING** POSSIBLE FILE ERROR"

           SET XMTEXT="^TMP(""IBERR"",$J,"

 +15       SET XMDUZ=.5

           SET XMY("G.IB ERROR")=""

           DO ^XMD

           KILL ^TMP("IBERR",$JOB)

           QUIT