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

IBDFFRFT.m

Go to the documentation of this file.
  1. IBDFFRFT ;ALB/CMR - AICS Free Forms Tracking Entry ; 27-MAR-97
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;**15,38**;APR 24, 1997
  1. ;
  1. ; -- modified 10/7/97 to allow background freeing via site parameter
  1. ;
  1. FREEFT ; -- called to pass data from FT to PCE regardless of whether all
  1. ; pages have been received.
  1. ;
  1. N FORMTYPE,IBFID,IBD,IBNODE,DFN,CLINIC,APPT,Y,PXCA,AUPNDAYS,AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,CNT,ORVP,PXCAVSIT,RESULT,SDFN
  1. D EN^VALM2($G(XQORNOD(0)))
  1. I $D(VALMY) D FULL^VALM1 S IBD=0 F S IBD=$O(VALMY(IBD)) Q:'IBD!$D(DIRUT) D
  1. .S IBFID=$P($G(^TMP("FRMIDX",$J,+IBD)),"^",2)
  1. .S IBNODE=$G(^IBD(357.96,+IBFID,0)) I IBNODE="" W !,"No Form Tracking record associated with entry #",IBD H 2 Q
  1. .I '$D(^XUSEC("IBD MANAGER",DUZ)) W !,"You must hold the IBD MANAGER key to free Forms Tracking entries" H 2 Q
  1. .I $P(IBNODE,"^",11)'=11 W !,"You may only pass data to PCE if the current status is PENDING PAGES" H 2 Q
  1. .S DFN=$P(IBNODE,"^",2),APPT=$P(IBNODE,"^",3),CLINIC=$P(IBNODE,"^",10)
  1. .;
  1. .; -- display ft data
  1. .W !!,"PATIENT: ",$P($G(^DPT(DFN,0)),"^")," APPT DATE/TIME: ",$$FMTE^XLFDT(APPT,2),!,"CLINIC: ",$P($G(^SC(CLINIC,0)),"^"),!
  1. .;
  1. .; -- display page data
  1. .S I=0 F S I=$O(^IBD(357.96,IBFID,9,I)) Q:'I S IBNODE=$G(^IBD(357.96,IBFID,9,I,0)) W !?5,"Page ",$P(IBNODE,"^")," ",$S(+$P(IBNODE,"^",2):"Received",1:"Not Received")
  1. .W ! S DIR(0)="Y",DIR("A")="Okay to continue",DIR("B")="Y" D ^DIR K DIR Q:'Y
  1. .D SEND(IBFID)
  1. ;
  1. D EXIT1^IBDFFT,START^IBDFFT1
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. SEND(IBFID,ERRCNT) ; -- send all page data in forms tracking
  1. ;
  1. ; -- gather data from previously stored pages
  1. S I=0 F S I=$O(^IBD(357.96,IBFID,10,I)) Q:'I D ARYAD^IBDFBKR($G(^IBD(357.96,IBFID,10,I,0)))
  1. ;
  1. ; -- send data to pce
  1. W:'$D(ZTQUEUED) !,"Sending Data to PCE..."
  1. S RESULT=$$SEND^IBDF18E(IBFID,"","",.BUBBLES,.HANDPRNT,"",.PXCA,.DYNAMIC)
  1. W:'$D(ZTQUEUED) $S(RESULT:"Successfull",1:"Unsuccessful")
  1. ;
  1. ; -- process any returned errors/warnings
  1. I $D(PXCA("ERROR"))!($D(PXCA("WARNING"))) D
  1. .N I,J,ERR,LCNT,DIR,DIRUT,DUOUT
  1. .S LCNT=0,ERRCNT=$G(ERRCNT)+1
  1. .D EW^IBDFBK2(.ERR,.PXCA,.LCNT)
  1. .;
  1. .W:'$D(ZTQUEUED) !!!,"The following Error(s) occurred while validating data in PCE for: ",$P($G(^DPT(DFN,0)),"^")
  1. .Q:$D(ZTQUEUED)
  1. .S I=0 F S I=$O(ERR(I)) Q:'I W !?4,$E(ERR(I),1,75) I $L(ERR(I))>75 W !?10,$E(ERR(I),76,140)
  1. .W !!
  1. Q
  1. ;
  1. BCKGRND ; -- entry point for back ground job to process pending pages
  1. ;
  1. N DAYS,START,END
  1. S DAYS=+$P($G(^IBD(357.09,1,0)),"^",11)
  1. ;
  1. Q:'DAYS
  1. S ERRCNT=0
  1. S START=DAYS+7
  1. S START=$$FMADD^XLFDT(DT,-START)
  1. S END=$$FMADD^XLFDT(DT,-DAYS)+.24
  1. ;
  1. B1 N CNT,ERRCNT,IBFID,STATUS
  1. F S START=$O(^IBD(357.96,"D",START)) Q:'START!(START>END) D
  1. .S IBFID=0
  1. .F S IBFID=$O(^IBD(357.96,"D",START,IBFID)) Q:'IBFID D
  1. ..S STATUS=$P($G(^IBD(357.96,IBFID,0)),"^",11)
  1. ..I STATUS=11 S CNT=$G(CNT)+1 D SEND(IBFID,.ERRCNT)
  1. ;
  1. D:$G(MANUAL) BULL
  1. I $D(ZTQUEUED),$G(MANUAL) S ZTREQ="@"
  1. Q
  1. ;
  1. BULL ; -- add bulletin or something to let people know what was done
  1. ; but only if they ask for it during testing.
  1. ;
  1. S IBD(1)="The background job to release pending pages has completed"
  1. S IBD(2)=""
  1. S IBD(3)=" Number of Forms Tracking Entries: "_+$G(CNT)
  1. S IBD(4)=" Number of Forms Generating Errors: "_+$G(ERRCNT)
  1. S XMSUB="AICS RELEASE PENDING PAGES"
  1. S XMDUZ="AICS PACKAGE",XMTEXT="IBD("
  1. K XMY S XMN=0
  1. S XMY(DUZ)=""
  1. D ^XMD
  1. K X,Y,IBD,XMDUZ,XMTEXT,XMY,XMSUB,XMN
  1. Q
  1. ;
  1. MANUAL ; -- entry point for sending pending pages to PCE for a date range
  1. ; get date range and do b1
  1. ;
  1. W !!,"Option to Manually send Encounter Forms in a Pending Pages Status in Forms"
  1. W !,"Tracking to PCE by Encounter date range.",!!
  1. ;
  1. S MANUAL=1
  1. S DAYS=+$P($G(^IBD(357.09,1,0)),"^",11)
  1. S HELP="Enter a START date. This is an exact date and should be in the past."
  1. S START=$$ASKDT("Start Date: ","T-"_(60+DAYS),"AEPQX","",DT,.HELP,"D SHELP^IBDFFRFT")
  1. I START<1 G MQ
  1. S HELP="Enter the END date. This must be after the start date an before today."
  1. S END=$$ASKDT("End Date: ","T-"_$S(DAYS:DAYS,1:15),"AEQX",START,DT,.HELP,"D EHELP^IBDFFRFT")
  1. I END<1!(END<START) G MQ
  1. S ZTRTN="B1^IBDFFRFT",ZTSAVE("START")="",ZTSAVE("END")="",ZTSAVE("DAYS")="",ZTSAVE("MANUAL")=""
  1. S ZTDESC="IBD-FREE FORMS TRACKING OF PENDING PAGES"
  1. S ZTIO=""
  1. W !!,"This option must be queued. No Device is Necessary."
  1. W !,"A mail message will be sent when the process has completed.",!!
  1. D ^%ZTLOAD
  1. MQ K X,Y,IBD,DAYS,START,END,MANUAL,HELP,ZTSK,ZTRTN,ZTSAVE,ZTSAVE,ZTDESC,ZTIO
  1. Q
  1. ;
  1. EHELP ; -- help for the end date prompt
  1. W !,"Enter the END date. This is an Encounter Date."
  1. W !,"This is the last date that forms that are in a Pending Pages Status in Forms"
  1. W !,"Tracking will be automatically sent to PCE for processing."
  1. Q
  1. ;
  1. SHELP ; -- help for start date prompt
  1. W !,"Enter the START date. This is an Encounter Date."
  1. W !,"This is the date that you want to start the process that sends forms that"
  1. W !,"are in a Pending Pages Status in Forms Tracking entries to PCE to start on."
  1. Q
  1. ;
  1. ASKDT(QUES,DEFLT,PARAM,EARLY,LATEST,HELP,EXHELP) ; -- ask date questions
  1. N X,Y,DIR,DIRUT,DTOUT,DUOUT,IBQUIT
  1. S DIR(0)="DOA^"_$E($G(EARLY),1,7)_":"_$G(LATEST)_":"_$S($G(PARAM)'="":PARAM,1:"AEQRX")
  1. I $G(QUES)'="" S DIR("A")=QUES
  1. I $G(DEFLT)'="" S DIR("B")=DEFLT
  1. I $L($G(EXHELP)) S DIR("??")="^"_EXHELP
  1. I $D(HELP) M DIR("?")=HELP
  1. D ^DIR
  1. I $D(DIRUT),Y'="" S Y=-1 ;i y="" user typed "@"
  1. I $D(DTOUT)!($D(DUOUT)) S IBQUIT=1,Y=-1
  1. Q Y