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