Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBY602PO

IBY602PO.m

Go to the documentation of this file. 
  1. IBY602PO ;EDE/DM - Post-Installation for IB*2.8*602 ; 23-MAR-2018
  1.  ;;2.0;INTEGRATED BILLING;**602**;09-AUG-2018;Build 22
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. POST ; POST ROUTINE(S)
  1.  N IBXPD,XPDIDTOT
  1.  S XPDIDTOT=1
  1.  ;
  1.  ; Task FIXTQ  
  1.  D TSKFIXTQ(1)
  1.  ;
  1.  ; Done...
  1.  D MES^XPDUTL("")
  1.  D MES^XPDUTL("POST-Install Completed.")
  1.  Q
  1.  ;
  1. TSKFIXTQ(IBXPD) ; task the FIXTQ routine
  1.  D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
  1.  D MES^XPDUTL("-------------")
  1.  D MES^XPDUTL("Tasking Examine/Clean IIV Response & IIV Transmission Queue ... ")
  1.  N MSG,ZTDESC,ZTRTN,ZTQUEUED
  1.  S ZTQUEUED=1
  1.  S ZTDESC="IBCN EXAMINE #365 & #365.1 FILES"
  1.  S ZTRTN="FIXTQ^IBY602PO"
  1.  S MSG=$$TASK("T@2000",ZTDESC,ZTRTN)
  1.  D MES^XPDUTL(MSG)
  1.  Q
  1.  ;
  1. TASK(X,ZTDESC,ZTRTN) ;bypass for queued task
  1.  N Y,IDT,XDT,TSK,MSG,ZTIO,ZTSK,%DT
  1.  S %DT="FR"
  1.  D ^%DT
  1.  S IDT=Y D DD^%DT S XDT=Y
  1.  ;
  1.  ;Check if task already scheduled for date/time
  1.  S TSK=$$GETTASK(IDT)
  1.  I TSK D  Q MSG
  1.  . S Y=$P(TSK,U,2) D DD^%DT
  1.  . S MSG=" Task (#"_+TSK_") already scheduled to run on "_Y
  1.  ;
  1.  ;Schedule the task
  1.  S TSK=$$SCHED(IDT)
  1.  ;
  1.  ;Check for scheduling problem
  1.  I '$G(TSK) S MSG=" Task Could Not Be Scheduled" Q MSG
  1.  ;
  1.  ;Send successful schedule message
  1.  S MSG=" Examine/Clean IIV Transmission Queue Scheduled for "_XDT
  1.  Q MSG
  1.  ;
  1. GETTASK(IDT) ;
  1.  N TASK,TASKNO,TDT,XUSUCI,Y,ZTSK0
  1.  ;
  1.  ;Retrieve UCI
  1.  X ^%ZOSF("UCI") S XUSUCI=Y
  1.  ; 
  1.  S (TASK,TDT)=0,TASKNO=""
  1.  F  S TASK=$O(^%ZTSK(TASK)) Q:'TASK  D  Q:TASKNO
  1.  .I $G(^%ZTSK(TASK,.03))[ZTDESC D
  1.  ..S ZTSK0=$G(^%ZTSK(TASK,0))
  1.  ..;
  1.  ..;Exclude tasks scheduled by TaskMan
  1.  ..Q:ZTSK0["ZTSK^XQ1"
  1.  ..;
  1.  ..;Exclude tasks in other ucis
  1.  ..Q:(($P(ZTSK0,U,11)_","_$P(ZTSK0,U,12))'=XUSUCI)
  1.  ..;
  1.  ..;Check for correct date and time
  1.  ..S TDT=$$HTFM^XLFDT($P(ZTSK0,"^",6))
  1.  ..;I TDT=IDT S TASKNO=TASK
  1.  Q TASKNO_U_TDT
  1.  ;
  1. SCHED(ZTDTH) ;
  1.  N XUSUCI,ZTIO,ZTSK
  1.  ;Retrieve UCI
  1.  X ^%ZOSF("UCI") S XUSUCI=Y
  1.  S ZTIO=""
  1.  D ^%ZTLOAD
  1.  Q ZTSK
  1.  ;
  1. FIXTQ(IBXPD) ; clean/report abnormal IIV TRANSMISSION QUEUE (#365.1) records
  1.  N DA,DIK,HLIEN,DNP,TQIEN,ENDDT,WKDT,WKZZ
  1.  N STATLIST,STAGE,TCNT,ACNT,MCNT,DONE
  1.  N BAD,TQS,TQD,TQQ,MSG,IBXMY
  1.  ;
  1.  S STATLIST=","_$$FIND1^DIC(365.14,,"B","Response Received")
  1.  S STATLIST=STATLIST_","_$$FIND1^DIC(365.14,,"B","Communication Failure")
  1.  S STATLIST=STATLIST_","_$$FIND1^DIC(365.14,,"B","Cancelled")_","
  1.  S (TQIEN,TCNT,STAGE,ACNT,MCNT,DONE)=0
  1.  S MSG=""
  1.  S ENDDT=$$FMADD^XLFDT(DT,-182) ; about 6 months
  1.  ; STAGE=0, delete abnormal < T-182
  1.  ; STAGE=1, report abnormal from T-182 through T-32
  1.  ;
  1.  D FIXRESP
  1.  ;
  1.  F  S TQIEN=$O(^IBCN(365.1,TQIEN)) Q:'TQIEN!DONE!$G(ZTSTOP)  D
  1.  . S TCNT=TCNT+1
  1.  . I $D(ZTQUEUED),TCNT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
  1.  . S TQD=$$GET1^DIQ(365.1,TQIEN_",",.06,"I") ; DATE/TIME CREATED
  1.  . S WKDT=+$P(TQD,".",1)
  1.  . I WKDT>ENDDT,STAGE S DONE=1 Q
  1.  . I WKDT>ENDDT S STAGE=1,ENDDT=$$FMADD^XLFDT(DT,-32)
  1.  . I WKDT>ENDDT S DONE=1 Q 
  1.  . ; check for abnormal 
  1.  . S BAD=0
  1.  . S TQS=$$GET1^DIQ(365.1,TQIEN_",",.04,"I") ; TRANSMISSION STATUS
  1.  . S TQQ=$$GET1^DIQ(365.1,TQIEN_",",.11,"I") ; QUERY FLAG 
  1.  . ; If the QUERY FLAG IS "I" and not an EICD Transaction entry will purge/report.
  1.  . S:TQQ="I"&'$D(^IBCN(365.18,"B",TQIEN)) BAD=1
  1.  . ; If the QUERY FLAG is null OR the DATE/TIME CREATED is null or 
  1.  . ; TRANSMISSION STATUS not in STATLIST entry will purge/report
  1.  . S:(TQQ="")!('TQD)!('$F(STATLIST,","_TQS_",")) BAD=1
  1.  . Q:'BAD
  1.  . I STAGE=0 D
  1.  .. ; loop through the HL7 messages multiple and kill any response
  1.  .. ; records that are found for this transmission queue entry.
  1.  .. ; Preserve the TQ and any response that has DO NOT PURGE set to 1 (YES) 
  1.  .. S DNP=0,HLIEN=0,DIK="^IBCN(365,"
  1.  .. F  S HLIEN=$O(^IBCN(365.1,TQIEN,2,HLIEN)) Q:'HLIEN  D
  1.  ... S DA=$P($G(^IBCN(365.1,TQIEN,2,HLIEN,0)),U,3) Q:'DA
  1.  ... I +$$GET1^DIQ(365,DA_",",.11,"I") S DNP=1 Q 
  1.  ... D ^DIK
  1.  ... Q
  1.  .. ; now we can kill the TQ entry itself 
  1.  .. ; as long as there was no DO NOT PURGE responses
  1.  .. I 'DNP S DA=TQIEN,DIK="^IBCN(365.1," D ^DIK
  1.  .. Q
  1.  . Q:'STAGE  ; not reporting abnormal yet
  1.  . S ACNT=ACNT+1 ; abnormal count 
  1.  . Q:MCNT>9  ; msg count, only want 10
  1.  . S MCNT=MCNT+1
  1.  . ;example of a detail line on the email 
  1.  . ;FEB 22, 2017@10:44:08 T#:xxxxxxxxxx *xxxxxxxxxxxxxxxxxxxxx *NO QFLAG 
  1.  . I 'TQD S $E(MSG(MCNT+2),1)="*NO DATE"
  1.  . I TQD S $E(MSG(MCNT+2),1)=$$GET1^DIQ(365.1,TQIEN_",",.06,"E") ;DATE/TIME CREATED
  1.  . S $E(MSG(MCNT+2),23)="T#:"_TQIEN
  1.  . I '$F(STATLIST,","_TQS_",") S $E(MSG(MCNT+2),40)=" *"_$$GET1^DIQ(365.1,TQIEN_",",.04,"E")
  1.  . S WKZZ=""
  1.  . I TQQ="" S WKZZ=" *NO QUERY FLAG"
  1.  . I TQQ="I" S WKZZ=" *QUERY FLAG: 'I'"
  1.  . S $E(MSG(MCNT+2),60)=WKZZ
  1.  ; send mailman msg
  1.  S WKDT=$$SITE^VASITE()
  1.  S MSG(1)="Patch IB*2.0*602 Post Install Issue Summary for station "_$P(WKDT,U,3)_":"_$P(WKDT,U,2)
  1.  S MSG(2)="-------------------------------------------------------------------------------"
  1.  I 'ACNT S MSG(3)=" NO ISSUES FOUND"
  1.  I ACNT D
  1.  . S MSG(MCNT+3)=""
  1.  . S MSG(MCNT+4)="TOTAL ISSUES DETECTED: "_ACNT
  1.  S IBXMY("vhaeinsurancerr@domain.ext")=""
  1.  D MSG^IBCNEUT5(,"Patch IB*2.0*602 Post Install Issue Summary ("_$P(WKDT,U,3)_")","MSG(",,.IBXMY)
  1.  ; Tell TaskManager to delete the task's record
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  Q
  1.  ;
  1. FIXRESP ;Populate Response entries with null date/time created.
  1.  N DIE,DR,DTM,RDTM,RIEN,RPDTM
  1.  S RIEN=0,RPDTM=$$FMADD^XLFDT(DT,-182)
  1.  F  S RIEN=$O(^IBCN(365,RIEN)) Q:'RIEN  D
  1.  . S TCNT=TCNT+1
  1.  . I $D(ZTQUEUED),TCNT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
  1.  . ;
  1.  . S DTM=$$GET1^DIQ(365,RIEN_",",.08,"I") I DTM Q
  1.  . S RDTM=$$GET1^DIQ(365,RIEN_",",.07,"I")
  1.  . I RDTM>RPDTM D
  1.  .. S ACNT=ACNT+1
  1.  .. I MCNT<6 D
  1.  ... S MCNT=MCNT+1
  1.  ... S $E(MSG(MCNT+2),1)="*NO DATE/TIME CR"
  1.  ... S $E(MSG(MCNT+2),23)="R#:"_$$GET1^DIQ(365,RIEN_",",.01)  ;MESSAGE CONTROL ID
  1.  ... S $E(MSG(MCNT+2),40)=" *"_$$GET1^DIQ(365,RIEN_",",.06)  ;TRANSMISSION STATUS
  1.  ... S $E(MSG(MCNT+2),60)=" *"_$$GET1^DIQ(365,RIEN_",",.1) ;RESPONSE TYPE
  1.  . S DTM=$S(RDTM:RDTM,1:"NOW")
  1.  . S DIE=365,DA=RIEN,DR=".08///"_DTM
  1.  . D ^DIE
  1.  Q
  1.  ;