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

SD53P215.m

Go to the documentation of this file. 
  1. SD53P215 ;BP-OIFO/KEITH - PRE/POST INSTALL SD*5.3*215 ; 27 Apr 2000 12:49 PM
  1.  ;;5.3;Scheduling;**215**;Aug 13 1993
  1.  ;
  1. ENV I DUZ(0)'="@" D
  1.  .W !!,$C(7),"     To insure that data updates contained in this patch are",!,"     installed correctly, DUZ(0) must be equal the ""@"" symbol!",!
  1.  .S XPDQUIT=2 Q
  1.  Q
  1.  ;
  1. POST ;Post init actions
  1.  D SEED,CODE Q
  1.  ;
  1. SEED ;Seed NPCD ENCOUNTER MONTH multiple (#404.9171) of the SCHEDULING
  1.  ;PARAMETER file (#404.91) with revised database close-out dates 
  1.  ;for FY2000
  1.  ;
  1.  ;Declare variables
  1.  N XPDIDTOT,LINE,DATES,WLMONTH,DBCLOSE,WLCLOSE,TMP
  1.  ;Print header
  1.  D BMES^XPDUTL(">>> Storing revised database close-out dates for Fiscal Year 2000")
  1.  S TMP=$$INSERT^SCDXUTL1("Workload","",7)
  1.  S TMP=$$INSERT^SCDXUTL1("Database",TMP,27)
  1.  S TMP=$$INSERT^SCDXUTL1("Workload",TMP,47)
  1.  D BMES^XPDUTL(TMP)
  1.  S TMP=$$INSERT^SCDXUTL1("Occurred In","",6)
  1.  S TMP=$$INSERT^SCDXUTL1("Close-Out",TMP,27)
  1.  S TMP=$$INSERT^SCDXUTL1("Close-Out",TMP,47)
  1.  D MES^XPDUTL(TMP)
  1.  S TMP=$$INSERT^SCDXUTL1("------------","",5)
  1.  S TMP=$$INSERT^SCDXUTL1("------------",TMP,25)
  1.  S TMP=$$INSERT^SCDXUTL1("------------",TMP,45)
  1.  D MES^XPDUTL(TMP)
  1.  ;Loop through list of dates
  1.  S XPDIDTOT=6
  1.  F LINE=2:1:7 S TMP=$T(FY00+LINE),DATES=$P(TMP,";",3) Q:(DATES="")  D
  1.  .;Break out info
  1.  .S WLMONTH=$P(DATES,"^",1)
  1.  .S DBCLOSE=$P(DATES,"^",2)
  1.  .S WLCLOSE=$P(DATES,"^",3)
  1.  .;Print close-out info
  1.  .S TMP=$$INSERT^SCDXUTL1($$FMTE^XLFDT(WLMONTH,"1D"),"",7)
  1.  .S TMP=$$INSERT^SCDXUTL1($$FMTE^XLFDT(DBCLOSE,"1D"),TMP,25)
  1.  .S TMP=$$INSERT^SCDXUTL1($$FMTE^XLFDT(WLCLOSE,"1D"),TMP,45)
  1.  .D MES^XPDUTL(TMP)
  1.  .;Store close-out info
  1.  .S TMP=$$AECLOSE^SCDXFU04(WLMONTH,DBCLOSE,WLCLOSE)
  1.  .;Write error message if datebase or workload dates not updated
  1.  .I TMP<0 D MES^XPDUTL("       >>> Could not update closeout dates for above month.")
  1.  .;If KIDS install, show progress through status bar
  1.  .D:($G(XPDNM)'="") UPDATE^XPDID(LINE-1)
  1.  D BMES^XPDUTL("")
  1.  Q
  1.  ;
  1. FY00 ;Revised Close-out dates for fiscal year 2000
  1.  ;  Month ^ Database Close-Out ^ Workload Close-Out
  1.  ;;2991000^3001013^2991112
  1.  ;;2991100^3001013^2991210
  1.  ;;2991200^3001013^3000107
  1.  ;;3000100^3001013^3000211
  1.  ;;3000200^3001013^3000310
  1.  ;;3000300^3001013^3000407
  1.  Q
  1.  ;
  1. CODE ;File new code to TRANSMITTED OUTPATIENT ENCOUNTER ERROR CODE file
  1.  ;(#409.76)
  1.  ;
  1.  N SDY
  1.  S SDY=$$FILE()
  1.  I SDY=-1 D  Q
  1.  .D MES^XPDUTL(">>> Unable to file error code '999', contact Customer Service for assistance.")
  1.  .Q
  1.  I $P(SDY,U,3)'=1 D  Q
  1.  .D MES^XPDUTL(">>> Error code '999' is already on file, no action taken.")
  1.  .Q
  1.  D MES^XPDUTL(">>> Error code '999 - Unknown reason' added to file #409.76.")
  1.  Q
  1.  ;
  1. FILE() ;File code
  1.  N DIC,DLAYGO,X,Y,SD
  1.  S SD(.02)="NPCD",SD(11)="Reason unknown"
  1.  S SD(21)="Rejected by NPCD without a valid reason, use the 'Retransmit Selected Error Code' [SCDX AMBCAR RETRANS ERROR] option to resend."
  1.  S SD(41)="S RTN=$$MSG^SCENIA1(""Use the 'Retransmit Selected Error Code' [SCDX AMBCAR RETRANS ERROR] option to resend."")"
  1.  S DIC="^SD(409.76,",DLAYGO=409.76,DIC(0)="L",X=999
  1.  S DIC("DR")=".02///^S X=SD(.02);11///^S X=SD(11);21///^S X=SD(21);41///^S X=SD(41)"
  1.  D ^DIC
  1.  Q Y
  1.  ;
  1. FIND ;Mark encounters that have been rejected for transmission due to the
  1.  ;midyear database closeout or have been transmitted but rejected by
  1.  ;NPCD without a valid reason for retransmission
  1.  ;
  1.  N SDSTAT
  1.  I DT>3001013 W !!,$C(7),"It is too late to run this utility!" Q
  1.  I $G(DUZ)<1 W !!,$C(7),"DUZ must be defined to run this utility!" Q
  1.  S SDSTAT=$O(^SD(409.63,"B","CHECKED OUT",0)) I 'SDSTAT W !!,"CHECKED OUT encounter status could not be identified!" K SDSTAT Q
  1.  N ZTSAVE S ZTSAVE("SDSTAT")=""
  1.  W ! D EN^XUTMDEVQ("START^SD53P215","Re-flag NPCDB activity",.ZTSAVE) Q
  1.  ;
  1. START ;Search for activity to re-flag for transmission
  1.  ;
  1.  N SDLINE,SDOUT,SDTIT,SDPAGE,X,Y,%,SDPNOW,SDDT,SDOE,SDOE0,SDSTX,SDTOT
  1.  N SDCT,SDXP,SDTEXT,SDSCT,SDSTOT
  1.  ;Initialize variables
  1.  K ^TMP("SD215",$J)
  1.  S SDLINE="",$P(SDLINE,"-",(IOM+1))="",SDOUT=0
  1.  S SDTIT="<*>  RE-FLAG UNSENT/REJECTED FY2000 NPCDB ACTIVITY FOR TRANSMISSION  <*>"
  1.  S SDPAGE=1 D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=Y
  1.  ;Search encounters by date range
  1.  S SDDT=2991000
  1.  F  S SDDT=$O(^SCE("B",SDDT)) Q:'SDDT  S SDOE=0 F  S SDOE=$O(^SCE("B",SDDT,SDOE)) Q:'SDOE  D
  1.  .S SDOE0=$G(^SCE(SDOE,0)) Q:'$L(SDOE0)
  1.  .;If date/patient/location/status/transmission status, set array
  1.  .I $P(SDOE0,U),$P(SDOE0,U,2),$P(SDOE0,U,4),$P(SDOE0,U,12)=SDSTAT,'$P(SDOE0,U,6) S SDSTX=$$STX^SCRPW8(SDOE,SDOE0) I "1^2^3^6"[+SDSTX D
  1.  ..S ^TMP("SD215",$J,+SDSTX,"CT")=$G(^TMP("SD215",$J,+SDSTX,"CT"))+1
  1.  ..S ^TMP("SD215",$J,+SDSTX,"TEXT")=SDSTX
  1.  ..S ^TMP("SD215",$J,+SDSTX,SDOE)=SDOE0
  1.  ..Q
  1.  .Q
  1.  ;Count records found
  1.  S (SDSTX,SDTOT)=0 F  S SDSTX=$O(^TMP("SD215",$J,SDSTX)) Q:'SDSTX  S SDTOT=SDTOT+^TMP("SD215",$J,SDSTX,"CT")
  1.  ;
  1.  ;Re-flag encounters for transmission
  1.  S (SDCT,SDSTX,SDOUT)=0
  1.  F  S SDSTX=$O(^TMP("SD215",$J,SDSTX)) Q:'SDSTX!SDOUT  D
  1.  .S SDOE=0 F  S SDOE=$O(^TMP("SD215",$J,SDSTX,SDOE)) Q:'SDOE!SDOUT  D
  1.  ..S SDDT=+^TMP("SD215",$J,SDSTX,SDOE)
  1.  ..S SDXP=$$CRTXMIT^SCDXFU01(SDOE,,SDDT)  ;Get the transmission record
  1.  ..Q:SDXP'>0
  1.  ..;Keep count by transmission status
  1.  ..S ^TMP("SD215",$J,SDSTX,"SENT")=$G(^TMP("SD215",$J,SDSTX,"SENT"))+1
  1.  ..S SDCT=SDCT+1 S:SDCT'<5000 SDOUT=1  ;Don't do more than 5000
  1.  ..D STREEVNT^SCDXFU01(SDXP,0)  ;Log the event
  1.  ..D XMITFLAG^SCDXFU01(SDXP,0)  ;Flag the record for transmission
  1.  ..Q
  1.  .Q
  1.  ;
  1.  ;Report the results
  1.  N SD,SDI,SDX S SDI=0
  1.  ;Set text array
  1.  D LINE("")
  1.  D LINE("                    Unsent/rejected FY2000 NPCD activity found")
  1.  D LINE("                    ------------------------------------------")
  1.  S SDSTX=0 F  S SDSTX=$O(^TMP("SD215",$J,SDSTX)) Q:'SDSTX  D
  1.  .S SDTEXT=$P(^TMP("SD215",$J,SDSTX,"TEXT"),U,2)
  1.  .S SDSCT=^TMP("SD215",$J,SDSTX,"CT"),SDX=""
  1.  .S $E(SDX,20)=$J(SDTEXT,30)_": "_$J(SDSCT,6,0) D LINE(SDX)
  1.  .Q
  1.  S SDX="",$E(SDX,20)=$J("TOTAL",30)_": "_$J(SDTOT,6,0) D LINE(SDX)
  1.  D LINE("")
  1.  D LINE("                       Encounters flagged for transmission")
  1.  D LINE("                       -----------------------------------")
  1.  S (SDSTOT,SDSTX)=0 F  S SDSTX=$O(^TMP("SD215",$J,SDSTX)) Q:'SDSTX  D
  1.  .S SDTEXT=$P(^TMP("SD215",$J,SDSTX,"TEXT"),U,2)
  1.  .S SDSCT=+$G(^TMP("SD215",$J,SDSTX,"SENT")),SDSTOT=SDSTOT+SDSCT
  1.  .S SDX="",$E(SDX,20)=$J(SDTEXT,30)_": "_$J(SDSCT,6,0) D LINE(SDX)
  1.  .Q
  1.  S SDX="",$E(SDX,20)=$J("TOTAL",30)_": "_$J(SDSTOT,6,0) D LINE(SDX)
  1.  I SDTOT>5000 D
  1.  .D LINE(""),LINE("")
  1.  .D LINE("  More than 5000 encounters were found that require retransmission.  To avoid")
  1.  .D LINE("  overloading HL7 and MailMan globals, this process is designed to send no")
  1.  .D LINE("  more than 5000 encounters at a time.  To complete the transmission of all")
  1.  .D LINE("  applicable activity, you are advised to re-run this utility on a subsequent")
  1.  .D LINE("  date.")
  1.  .Q
  1.  ;
  1. MAIL ;Send mail message
  1.  N XMSUB,XMDUZ,XMDUN,XMTEXT,XMY,XMZ
  1.  S XMSUB="Encounter retransmission utility"
  1.  S (XMDUN,XMDUZ)="Patch SD*5.3*215"
  1.  S XMTEXT="SD(",XMY(DUZ)=""
  1.  D ^XMD
  1.  ;
  1. PRINT ;Print report
  1.  D HDR
  1.  N COL S COL=(IOM-80\2)
  1.  S SDI=0 F  S SDI=$O(SD(SDI)) Q:'SDI  D
  1.  .D:$Y>(IOSL-3) HDR
  1.  .W !?(COL),SD(SDI)
  1.  .Q
  1.  ; 
  1. EXIT K ^TMP("SD215",$J) Q
  1.  ;
  1.  ;
  1. LINE(SDX) ;Create text array node
  1.  S SDI=SDI+1,SD(SDI)=SDX
  1.  Q
  1.  ;
  1. HDR ;Print report header
  1.  W:SDPAGE>1 @IOF
  1.  W SDLINE,!?(IOM-$L(SDTIT)\2),SDTIT,!,SDLINE,!,"Date printed:",SDPNOW
  1.  W ?(IOM-6-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1 Q