- IB20P533 ;ALB/RRA - UPDATE IIV TRANSMISSION QUEUE ; 11/5/14 9:28am
- ;;2.0;INTEGRATED BILLING;**533**;21-MAR-94;Build 5
- ;;Per VA Directive 6402, this routine should not be modified.
- Q
- PRE ;
- ; Update IIV TRANSMISSION QUEUE file (#365.1)
- D MES^XPDUTL("Starting IB*2*533 Pre-Install....")
- D UPDATE
- D MES^XPDUTL("Patch Pre-Install is complete.")
- Q
- ;
- UPDATE ;
- N IBCN0,IBINS,IBWE,IBCNO,IBSD,IBCNT,IBNOW,IBX,IBQF
- S IBX=0,IBCNT=0
- ;LOOP THROUGH TRANSMISSION STATUS TO FIND RECORDS "READY TO TRASMIT"
- D MES^XPDUTL(""),MES^XPDUTL(">>>Processing records.....""")
- F S IBX=$O(^IBCN(365.1,"AC",1,IBX)) Q:IBX="" D
- . S IBCN0=$G(^IBCN(365.1,IBX,0)),IBQF=$P($G(IBCN0),"^",11)
- . I IBQF="I" D FILE Q
- . S IBINS=$P($G(IBCN0),"^",13),IBWE=$P($G(IBCN0),"^",10),IBSD=$P($G(IBCN0),"^",12),IBNOW=$$NOW^XLFDT
- . ;QUIT UNLESS THE EXTRACT IS FOR APPOINTMENT (2)
- . Q:IBWE'=2
- . ;QUIT UNLESS THE SERVICE DATE IS IN PAST
- . Q:IBSD>IBNOW
- . ;THE REMAINING RECORDS NEED TO BE CANCELLED AND UPDATED WITH A STATUS DATE OF "NOW"
- . D FILE Q
- ;process "Hold" records with query flag = Identification
- S IBX=0
- F S IBX=$O(^IBCN(365.1,"AC",4,IBX)) Q:IBX="" D
- . I $P($G(^IBCN(365.1,IBX,0)),"^",11)="I" D FILE
- . Q
- ;process "Retry" records with query flag = Identification
- S IBX=0
- F S IBX=$O(^IBCN(365.1,"AC",6,IBX)) Q:IBX="" D
- . I $P($G(^IBCN(365.1,IBX,0)),"^",11)="I" D FILE
- . Q
- ;
- D MES^XPDUTL("Total of "_IBCNT_" code"_$S(IBCNT'=1:"s",1:"")_" updated in the IIV TRANSMISSION QUEUE file (#365.1)")
- D MES^XPDUTL("")
- Q
- ;FILE UPDATE
- FILE ;
- N DA,DIE,DR,X,Y
- S IBNOW=$$NOW^XLFDT
- S DIE="^IBCN(365.1,",DA=IBX,DR=".04///"_"Cancelled"_";.15///"_IBNOW D ^DIE
- S IBCNT=IBCNT+1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P533 1713 printed Mar 13, 2025@21:08:18 Page 2
- IB20P533 ;ALB/RRA - UPDATE IIV TRANSMISSION QUEUE ; 11/5/14 9:28am
- +1 ;;2.0;INTEGRATED BILLING;**533**;21-MAR-94;Build 5
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- PRE ;
- +1 ; Update IIV TRANSMISSION QUEUE file (#365.1)
- +2 DO MES^XPDUTL("Starting IB*2*533 Pre-Install....")
- +3 DO UPDATE
- +4 DO MES^XPDUTL("Patch Pre-Install is complete.")
- +5 QUIT
- +6 ;
- UPDATE ;
- +1 NEW IBCN0,IBINS,IBWE,IBCNO,IBSD,IBCNT,IBNOW,IBX,IBQF
- +2 SET IBX=0
- SET IBCNT=0
- +3 ;LOOP THROUGH TRANSMISSION STATUS TO FIND RECORDS "READY TO TRASMIT"
- +4 DO MES^XPDUTL("")
- DO MES^XPDUTL(">>>Processing records.....""")
- +5 FOR
- SET IBX=$ORDER(^IBCN(365.1,"AC",1,IBX))
- if IBX=""
- QUIT
- Begin DoDot:1
- +6 SET IBCN0=$GET(^IBCN(365.1,IBX,0))
- SET IBQF=$PIECE($GET(IBCN0),"^",11)
- +7 IF IBQF="I"
- DO FILE
- QUIT
- +8 SET IBINS=$PIECE($GET(IBCN0),"^",13)
- SET IBWE=$PIECE($GET(IBCN0),"^",10)
- SET IBSD=$PIECE($GET(IBCN0),"^",12)
- SET IBNOW=$$NOW^XLFDT
- +9 ;QUIT UNLESS THE EXTRACT IS FOR APPOINTMENT (2)
- +10 if IBWE'=2
- QUIT
- +11 ;QUIT UNLESS THE SERVICE DATE IS IN PAST
- +12 if IBSD>IBNOW
- QUIT
- +13 ;THE REMAINING RECORDS NEED TO BE CANCELLED AND UPDATED WITH A STATUS DATE OF "NOW"
- +14 DO FILE
- QUIT
- End DoDot:1
- +15 ;process "Hold" records with query flag = Identification
- +16 SET IBX=0
- +17 FOR
- SET IBX=$ORDER(^IBCN(365.1,"AC",4,IBX))
- if IBX=""
- QUIT
- Begin DoDot:1
- +18 IF $PIECE($GET(^IBCN(365.1,IBX,0)),"^",11)="I"
- DO FILE
- +19 QUIT
- End DoDot:1
- +20 ;process "Retry" records with query flag = Identification
- +21 SET IBX=0
- +22 FOR
- SET IBX=$ORDER(^IBCN(365.1,"AC",6,IBX))
- if IBX=""
- QUIT
- Begin DoDot:1
- +23 IF $PIECE($GET(^IBCN(365.1,IBX,0)),"^",11)="I"
- DO FILE
- +24 QUIT
- End DoDot:1
- +25 ;
- +26 DO MES^XPDUTL("Total of "_IBCNT_" code"_$SELECT(IBCNT'=1:"s",1:"")_" updated in the IIV TRANSMISSION QUEUE file (#365.1)")
- +27 DO MES^XPDUTL("")
- +28 QUIT
- +29 ;FILE UPDATE
- FILE ;
- +1 NEW DA,DIE,DR,X,Y
- +2 SET IBNOW=$$NOW^XLFDT
- +3 SET DIE="^IBCN(365.1,"
- SET DA=IBX
- SET DR=".04///"_"Cancelled"_";.15///"_IBNOW
- DO ^DIE
- +4 SET IBCNT=IBCNT+1
- +5 QUIT
