- 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 ---[H[J[2J[HIBARXEC4 2153 printed Jan 18, 2025@03:08:24 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