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

SD53430P.m

Go to the documentation of this file. 
  1. SD53430P ;WOIFO/CLC - PFSS Scheduled Outpatient Conversion Backload ;22-APR-2005
  1.  ;;5.3;Scheduling;**430,1015**;Aug 13, 1993;Build 21
  1.  D HDR
  1.  Q
  1.  ;
  1. PRECHK ;
  1.  N VCNT
  1.  D HDR W !!,"Pre-Backload Analysis - Outpatient future appointments."
  1.  S VCNT=$$FUTRAPP(0)
  1.  I VCNT<0 W !,"Analysis exited without processing..." Q
  1.  W !!,VCNT," Outpatient future appointments identified in VistA..."
  1.  W !!,"Analysis complete...."
  1.  Q
  1. FUTRAPP(CMP) ;
  1.  N I,DFN,APP,STDT,DT,APPINFO
  1.  S (DFN,APP)=0
  1.  S STDT=$$GETRESP($$NOW^XLFDT(),"Future Appointment search start date") I STDT="" S APP=-1 G OFAQ
  1.  W !,"Checking VistA future appointments ",STDT," forward..."
  1.  F I=1:1 S DFN=$O(^DPT(DFN)) Q:+DFN<1  D
  1.     .I I#10000=0 W "."
  1.     .S DT=STDT
  1.     .F  S DT=$O(^DPT(DFN,"S",DT)) Q:+DT<1  D
  1.       ..S APPINFO=$G(^DPT(DFN,"S",DT,0))
  1.       ..I APPINFO="" W !,"Invalid Patient Appointment Node:",DFN,"-",DT Q
  1.       ..I $P(APPINFO,"^",2)="" D
  1.          ...S APP=APP+1
  1.          ...I CMP I $G(^TMP($J,"OFA",DFN))="" S EXC(DFN_"^"_DT)=^DPT(DFN,0)
  1. OFAQ Q APP
  1. POSTCHK ;
  1.  N PATH,FILENM,LN,TMP,I,DFN,BLCNT,EXC,VCNT
  1.  D HDR W !!,"Post-Backload Analysis - Outpatient future appointments."
  1.  S FILENM="SDCONV_ACCT.TXT",BLCNT=0,PATH=$$PWD^%ZISH()
  1.  S PATH=$$GETRESP(PATH,"Select Backload Path") Q:PATH=""
  1.  I '$$LISTF(PATH) S FILENM=""
  1.  S FILENM=$$GETRESP(FILENM,"Select Backload File") Q:FILENM=""
  1.  ;
  1.  K ^TMP($J,"OFA")
  1.  D OPEN^%ZISH("SD",PATH,FILENM,"R")
  1.  F  U IO R LN:1 Q:LN']""  S ^TMP($J,"OFA",$P(LN,"^"))=LN,BLCNT=BLCNT+1
  1.  D CLOSE^%ZISH(IO)
  1.  ;
  1.  W !!,"File: ",FILENM," contains: ",BLCNT," records."
  1.  S VCNT=$$FUTRAPP(1)
  1.  W !!,VCNT," Outpatient future appointments identified in VistA..."
  1.  ;
  1.  W !,"   VistA Total:",$J(VCNT,10)
  1.  W !,"Backload Total:",$J(BLCNT,10)
  1.  W !,"=================================="
  1.  W !,"               ",$J(VCNT-BLCNT,10)
  1.  ;
  1.  I '$D(EXC) W !,"No Discrepencies between VistA and the Backload file" Q
  1.  W !!,"Missing patients from backload file:",!
  1.  S DFN=0
  1.  F I=1:1 S DFN=$O(EXC(DFN)) Q:DFN=""  W !,I,") ",DFN,"^",EXC(DFN)
  1.  W !!,"Post analysis complete...."
  1.  K ^TMP($J,"OFA")
  1.  Q
  1. EP1 ;
  1.  N CNT,GOOD,ERR,SDKEY,ANS,PATH,Y,FN,GFILE,RFILE,FILENM
  1.  S SDKEY="SDCONV_ACCT.TXT",FILENM=SDKEY
  1.  S PATH=$$PWD^%ZISH(),(CNT,GOOD)=0
  1.  D HDR
  1.  S PATH=$$GETRESP(PATH,"Select Backload Path") Q:PATH=""
  1.  ;
  1.  I '$$LISTF(PATH) S FILENM=""
  1.  S FILENM=$$GETRESP(FILENM,"Select Backload File") Q:FILENM=""
  1.  S CNT=$$LOADFILE(PATH,FILENM)
  1.  ;
  1.  I CNT>0 S GOOD=$$PROCESS(CNT)
  1.  D RPTERR(CNT,GOOD,PATH_FILENM)
  1.  W !!,"Finished.... Mailman message sent to:",$$GET1^DIQ(200,DUZ,.01)," and G.PATCHES"
  1.  Q
  1. LISTF(PATH) ;
  1.  N GFILE,Y,RFILE,FN
  1.  S GFILE("SD*.TXT")=""
  1.  S Y=$$LIST^%ZISH(PATH,"GFILE","RFILE")
  1.  W !!,"SD*.TXT Files in ",PATH,!,"=================================="
  1.  I Y=1 S FN="" F  S FN=$O(RFILE(FN))  Q:FN=""  W !,?10,FN
  1.  I Y=0 W !!,?10,"** No files matching the SD*.TXT filter exists **"
  1.  Q Y
  1. HDR ;
  1.  D HOME^%ZIS  W @IOF
  1.  W !!,"==========================================================="
  1.  W !,"Scheduled Outpatient Conversion Backload",!
  1.  W !,"    **********************************************************"
  1.  W !,"    * This Routine should ONLY be run by PFSS Implementation *"
  1.  W !,"    * Staff.  DO NOT run this routine as part of the normal  *"
  1.  W !,"    * Patch installation process.                            *"
  1.  W !,"    **********************************************************"
  1.  W !!,"==========================================================="
  1.  Q
  1. GETRESP(DEF,TXT) ;
  1.  N DIR,DIRUT,DTOUT,X,Y
  1.  S DIR(0)="Fr",DIR("A")=TXT,DIR("B")=DEF D ^DIR
  1.  I $D(DIRUT)!$D(DTOUT) S Y=""
  1.  Q Y
  1. RPTERR(CNT,GOOD,FULLPATH) ;
  1.  N REC,CAT,ROW,ERR,ET,DETAIL
  1.  N XMDF,XMDUZ,XMSUB,XMDUN,XMTEXT,XMSTRIP,XMROU,XMY,XMZ,XMMG
  1.  S XMDF="",XMDUZ="SD53430P-"_$TR($P($$SITE^VASITE(),"^",2,3),"^","-")
  1.  S XMY(DUZ)="",XMY("G.PATCHES")=""
  1.  S XMSUB="PFSS Scheduled Outpatient Conversion"
  1.  D XMZ^XMA2                                 ; Call Create Message Module
  1.  I XMZ<1 D  Q
  1.    .W !!,"** UNABLE TO CREATE MAILMAN MESSAGE PLEASE CHECK XTMP FOR DETAILS!"
  1.  ;
  1.  S ^XMB(3.9,XMZ,2,1,0)="Scheduled OutPatient Conversion Backload"
  1.  S ^XMB(3.9,XMZ,2,2,0)="             File: "_FULLPATH
  1.  S ^XMB(3.9,XMZ,2,3,0)="           Run By: "_$$GET1^DIQ(200,DUZ,.01)
  1.  S ^XMB(3.9,XMZ,2,4,0)=""
  1.  S ^XMB(3.9,XMZ,2,5,0)="Sucessful Records: "_GOOD
  1.  S ^XMB(3.9,XMZ,2,7,0)="                 ----------------------"
  1.  S ^XMB(3.9,XMZ,2,8,0)="  Total Processed: "_CNT
  1.  S ^XMB(3.9,XMZ,2,9,0)="==============================================="
  1.  ;
  1.  S REC="",ROW=9,ERR=0
  1.  F  S REC=$O(^XTMP(SDKEY,"ERR",REC)) Q:REC=""  D
  1.    .S ERR=ERR+1,ROW=ROW+1
  1.    .S ^XMB(3.9,XMZ,2,ROW,0)="Record: "_REC_"     ----------------------"
  1.    .S CAT=""
  1.    .F  S CAT=$O(^XTMP(SDKEY,"ERR",REC,CAT)) Q:CAT=""  D
  1.       ..S ROW=ROW+1,^XMB(3.9,XMZ,2,ROW,0)="   "_CAT
  1.       ..S ET=""
  1.       ..F  S ET=$O(^XTMP(SDKEY,"ERR",REC,CAT,ET)) Q:ET=""  D
  1.          ...S ROW=ROW+1
  1.          ...S ^XMB(3.9,XMZ,2,ROW,0)="        "_^XTMP(SDKEY,"ERR",REC,CAT,ET)
  1.  ;
  1.  S ^XMB(3.9,XMZ,2,6,0)="    Error Records: "_ERR
  1.  I ROW=9 S ROW=10,^XMB(3.9,XMZ,2,ROW,0)="Sucessful Backload..... No ERRORS found..."
  1.  ;
  1.  S ^XMB(3.9,XMZ,2,0)="^3.92^"_ROW_"^"_ROW_"^"_$$NOW^XLFDT()
  1.  D ENT1^XMD                                                 ;Deliver MSG
  1.  K ^XTMP(SDKEY)
  1.  Q
  1. LOADFILE(PATH,FILENM) ;
  1.  N POP,NOW,PURGDT,STOP,TOT,LN
  1.  W !,"Loading backload file..."
  1.  K ^XTMP(SDKEY)
  1.  S NOW=$$NOW^XLFDT(),PURGDT=NOW+2,TOT=0             ;Purge 2 days later
  1.  S ^XTMP(SDKEY,0)=PURGDT_"^"_NOW_"^PFSS Scheduled Outpatient Back Load"
  1.  ;
  1.  D OPEN^%ZISH("SD",PATH,FILENM,"R")
  1.  I $G(POP) S ^XTMP(SDKEY,"ERR",0,"FATAL",1)="Could NOT PROCESS File!"
  1.  ;
  1.  S (STOP,TOT)=0
  1.  F  U IO R LN:1 Q:LN']""  Q:$$STATUS^%ZISH  Q:STOP  D
  1.     .I $G(LN)="" S STOP=1 Q
  1.     .S TOT=TOT+1,^XTMP(SDKEY,"DAT",TOT)=LN I TOT#1000=0 U 0 W "."
  1.  ;
  1.  D CLOSE^%ZISH(IO)
  1. LFQ Q TOT
  1.  ;
  1. PROCESS(TOT) ;
  1.  N CNT,INFO,DFN,SDT,SDCLN,SDEXVN,SDANR,SDCHK,GOOD
  1.  W !,"Processing data..."
  1.  S GOOD=0
  1.  F CNT=1:1:TOT D
  1.     .I CNT#1000=0 W "."
  1.     .S INFO=^XTMP(SDKEY,"DAT",CNT)
  1.     .S DFN=$P(INFO,"^",1),SDT=$P(INFO,"^",18)
  1.     .S SDCLN=$P(INFO,"^",8),SDEXVN=$TR($P(INFO,"^",21)," ","")
  1.     .;
  1.     .Q:$$CHKINFO(CNT,DFN,SDT,SDCLN,SDEXVN)
  1.     .S SDANR=$$GETARN^SDPFSS2(SDT,DFN,SDCLN)
  1.     .I +SDANR>0 D  Q
  1.        ..I $$EXTNUM^IBBAPI(DFN,SDANR)'=SDEXVN D  Q
  1.            ...S ^XTMP(SDKEY,"ERR",CNT,"ACCT",1)="Visit Number Discrepancy: "_INFO_" NOT EQUAL: "_SDANR
  1.        ..S GOOD=GOOD+1
  1.     .;
  1.     .S SDANR=$$IBBACONV^IBBAADTI(DFN,"O",SDT,SDCLN,SDEXVN)
  1.     .I SDANR="" S ^XTMP(SDKEY,"ERR",CNT,"ACCT",2)="PFSS Account Reference NOT Created" Q
  1.     .;
  1.     .S SDCHK=$$FILE^SDPFSS(DFN,SDT,SDCLN,SDANR)
  1.     .I +SDCHK<0 D
  1.        ..S ^XTMP(SDKEY,"ERR",CNT,"APPT LINK",1)="Unable to update file 409.55"
  1.        ..S ^XTMP(SDKEY,"ERR",CNT,"APPT LINK",2)=SDCHK
  1.     .I SDCHK="" S ^XTMP(SDKEY,"ERR",CNT,"APPT LINK",3)="Link Already Exists:"_INFO
  1.     .I +SDCHK=1 S GOOD=GOOD+1
  1.  Q GOOD
  1. CHKINFO(CNT,DFN,SDT,SDCLN,SDEXVN) ;
  1.  I SDEXVN="" S ^XTMP(SDKEY,"ERR",CNT,"IDX",1)="NO IDX Vist Number:"_INFO
  1.  ;
  1.  I +DFN=0 S ^XTMP(SDKEY,"ERR",CNT,"PATIENT",1)="DFN Invalid or Missing"
  1.  I +DFN>0 D
  1.    .I $G(^DPT(DFN,0))="" S ^XTMP(SDKEY,"ERR",CNT,"PATIENT",2)="Invalid Patient: "_DFN
  1.  ;
  1.  I +SDT=0 S ^XTMP(SDKEY,"ERR",CNT,"APPT DT/TIME",1)="Appointment Date/Time Invalid or Missing"
  1.  ;
  1.  I +SDCLN=0 S ^XTMP(SDKEY,"ERR",CNT,"LOCATION",1)="Location Invalid or Missing"
  1.  I +SDCLN>0 D
  1.    .I $G(^SC(SDCLN,0))="" S ^XTMP(SDKEY,"ERR",CNT,"LOCATION",2)="Invalid Location:"_SDCLN
  1.  Q $D(^XTMP(SDKEY,"ERR",CNT))
  1.  ;