IB534PST ;ALB/DMB - Post Install for IB*2*534 ;10/21/2014
;;2.0;INTEGRATED BILLING;**534**;21-MAR-94;Build 18
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN ; entry point
D BMES^XPDUTL(" Starting post-install for IB*2*534")
;
; Populate the New Non-Billable Status field
D NBJOB
;
; Completion Message
D BMES^XPDUTL(" Finish of IB*2.0*534 post-install")
Q
;
NBJOB ;
D BMES^XPDUTL(" Queuing background job to update the Non-Billable Status field")
D MES^XPDUTL(" A Mailman message will be sent when it finishes")
;
; Setup required variables
S ZTRTN="NBSTATUS^IB534PST",ZTIO="",ZTDTH=$H
S ZTDESC="Background job to update the Non-Billable Status field via IB*2*534"
;
; Task the job
D ^%ZTLOAD
;
; Check if task was created
I $D(ZTSK) D MES^XPDUTL(" Task #"_ZTSK_" queued")
I '$D(ZTSK) D MES^XPDUTL(" Task not queued. Please create a support ticket.")
Q
;
NBSTATUS ;
; Update the New Non-Billable Status field (#.02) of IB NCPDP EVENT LOG (#366.14)
;
N IEN,IEN1,X0,REASON,NBSTS,ERRCNT,SUCCNT,DIE,DA,DR,X,Y,DTOUT,DUOUT,DIC
;
; Loop through the IB NCPDP Event Log
S ERRCNT=0,SUCCNT=0
S IEN=0 F S IEN=$O(^IBCNR(366.14,IEN)) Q:'IEN D
. S IEN1=0 F S IEN1=$O(^IBCNR(366.14,IEN,1,IEN1)) Q:'IEN1 D
.. S X0=$G(^IBCNR(366.14,IEN,1,IEN1,0))
.. ;
.. ; If not a Billable Status Check, quit
.. I +X0'=1 Q
.. ;
.. ; If successful, quit
.. I $P(X0,"^",7)'=0 Q
.. ;
.. ; If already populated, quit
.. S NBSTS=$P(X0,U,2)
.. I NBSTS]"" Q
.. ;
.. ; Get reason and see if it exists
.. S REASON=$P(X0,U,8)
.. I REASON="" Q
.. ;
.. ; Convert to the proper format and see if it exists in the IB NCPDP NON-BILLABLE STATUS dictionary
.. S REASON=$TR($E($$UP^XLFSTR(REASON),1,60),"^")
.. I $E(REASON,$L(REASON))="." S REASON=$E(REASON,1,$L(REASON)-1)
.. S NBSTS=$O(^IBCNR(366.17,"B",REASON,""))
.. ;
.. ; If it does not exist not, add to the dictionary
.. I NBSTS="" D I Y=-1 Q
... S DIC="^IBCNR(366.17,",DIC(0)="F",X=REASON
... D FILE^DICN
... I Y=-1 S ERRCNT=ERRCNT+1
... S NBSTS=+Y
.. ;
.. ; Update the file
.. S DIE="^IBCNR(366.14,"_IEN_",1,",DA=IEN1,DA(1)=IEN,DR=".02////^S X=NBSTS"
.. D ^DIE
.. S SUCCNT=SUCCNT+1
;
; Send email with result
D MAIL(SUCCNT,ERRCNT)
Q
;
MAIL(SUCCNT,ERRCNT) ;
N CNT,MSG,XMY,XMDUZ,DIFROM,XMSUB,XMTEXT
S XMY(DUZ)=""
S XMSUB="IB*2.0*534 Post install is complete",XMDUZ="Patch IB*2.0*534"
S XMTEXT="MSG("
S CNT=1,MSG(CNT)=""
S CNT=CNT+1,MSG(CNT)="Patch IB*2.0*534 post install routine has completed."
S CNT=CNT+1,MSG(CNT)=""
S CNT=CNT+1,MSG(CNT)="Updated "_SUCCNT_" records in the IB NCPDP EVENT LOG."
I ERRCNT D
. S CNT=CNT+1,MSG(CNT)=ERRCNT_" dictionary entries were not created."
. S CNT=CNT+1,MSG(CNT)="Create a support ticket to resolve failures."
S CNT=CNT+1,MSG(CNT)=""
S CNT=CNT+1,MSG(CNT)="For more information about this post install, review the patch description."
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB534PST 3014 printed Dec 13, 2024@02:05:47 Page 2
IB534PST ;ALB/DMB - Post Install for IB*2*534 ;10/21/2014
+1 ;;2.0;INTEGRATED BILLING;**534**;21-MAR-94;Build 18
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ; entry point
+1 DO BMES^XPDUTL(" Starting post-install for IB*2*534")
+2 ;
+3 ; Populate the New Non-Billable Status field
+4 DO NBJOB
+5 ;
+6 ; Completion Message
+7 DO BMES^XPDUTL(" Finish of IB*2.0*534 post-install")
+8 QUIT
+9 ;
NBJOB ;
+1 DO BMES^XPDUTL(" Queuing background job to update the Non-Billable Status field")
+2 DO MES^XPDUTL(" A Mailman message will be sent when it finishes")
+3 ;
+4 ; Setup required variables
+5 SET ZTRTN="NBSTATUS^IB534PST"
SET ZTIO=""
SET ZTDTH=$HOROLOG
+6 SET ZTDESC="Background job to update the Non-Billable Status field via IB*2*534"
+7 ;
+8 ; Task the job
+9 DO ^%ZTLOAD
+10 ;
+11 ; Check if task was created
+12 IF $DATA(ZTSK)
DO MES^XPDUTL(" Task #"_ZTSK_" queued")
+13 IF '$DATA(ZTSK)
DO MES^XPDUTL(" Task not queued. Please create a support ticket.")
+14 QUIT
+15 ;
NBSTATUS ;
+1 ; Update the New Non-Billable Status field (#.02) of IB NCPDP EVENT LOG (#366.14)
+2 ;
+3 NEW IEN,IEN1,X0,REASON,NBSTS,ERRCNT,SUCCNT,DIE,DA,DR,X,Y,DTOUT,DUOUT,DIC
+4 ;
+5 ; Loop through the IB NCPDP Event Log
+6 SET ERRCNT=0
SET SUCCNT=0
+7 SET IEN=0
FOR
SET IEN=$ORDER(^IBCNR(366.14,IEN))
if 'IEN
QUIT
Begin DoDot:1
+8 SET IEN1=0
FOR
SET IEN1=$ORDER(^IBCNR(366.14,IEN,1,IEN1))
if 'IEN1
QUIT
Begin DoDot:2
+9 SET X0=$GET(^IBCNR(366.14,IEN,1,IEN1,0))
+10 ;
+11 ; If not a Billable Status Check, quit
+12 IF +X0'=1
QUIT
+13 ;
+14 ; If successful, quit
+15 IF $PIECE(X0,"^",7)'=0
QUIT
+16 ;
+17 ; If already populated, quit
+18 SET NBSTS=$PIECE(X0,U,2)
+19 IF NBSTS]""
QUIT
+20 ;
+21 ; Get reason and see if it exists
+22 SET REASON=$PIECE(X0,U,8)
+23 IF REASON=""
QUIT
+24 ;
+25 ; Convert to the proper format and see if it exists in the IB NCPDP NON-BILLABLE STATUS dictionary
+26 SET REASON=$TRANSLATE($EXTRACT($$UP^XLFSTR(REASON),1,60),"^")
+27 IF $EXTRACT(REASON,$LENGTH(REASON))="."
SET REASON=$EXTRACT(REASON,1,$LENGTH(REASON)-1)
+28 SET NBSTS=$ORDER(^IBCNR(366.17,"B",REASON,""))
+29 ;
+30 ; If it does not exist not, add to the dictionary
+31 IF NBSTS=""
Begin DoDot:3
+32 SET DIC="^IBCNR(366.17,"
SET DIC(0)="F"
SET X=REASON
+33 DO FILE^DICN
+34 IF Y=-1
SET ERRCNT=ERRCNT+1
+35 SET NBSTS=+Y
End DoDot:3
IF Y=-1
QUIT
+36 ;
+37 ; Update the file
+38 SET DIE="^IBCNR(366.14,"_IEN_",1,"
SET DA=IEN1
SET DA(1)=IEN
SET DR=".02////^S X=NBSTS"
+39 DO ^DIE
+40 SET SUCCNT=SUCCNT+1
End DoDot:2
End DoDot:1
+41 ;
+42 ; Send email with result
+43 DO MAIL(SUCCNT,ERRCNT)
+44 QUIT
+45 ;
MAIL(SUCCNT,ERRCNT) ;
+1 NEW CNT,MSG,XMY,XMDUZ,DIFROM,XMSUB,XMTEXT
+2 SET XMY(DUZ)=""
+3 SET XMSUB="IB*2.0*534 Post install is complete"
SET XMDUZ="Patch IB*2.0*534"
+4 SET XMTEXT="MSG("
+5 SET CNT=1
SET MSG(CNT)=""
+6 SET CNT=CNT+1
SET MSG(CNT)="Patch IB*2.0*534 post install routine has completed."
+7 SET CNT=CNT+1
SET MSG(CNT)=""
+8 SET CNT=CNT+1
SET MSG(CNT)="Updated "_SUCCNT_" records in the IB NCPDP EVENT LOG."
+9 IF ERRCNT
Begin DoDot:1
+10 SET CNT=CNT+1
SET MSG(CNT)=ERRCNT_" dictionary entries were not created."
+11 SET CNT=CNT+1
SET MSG(CNT)="Create a support ticket to resolve failures."
End DoDot:1
+12 SET CNT=CNT+1
SET MSG(CNT)=""
+13 SET CNT=CNT+1
SET MSG(CNT)="For more information about this post install, review the patch description."
+14 DO ^XMD
+15 QUIT
