- BCHEXDI3 ; IHS/CMI/LAB - initialization part III ;
- ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
- ;
- ;CHR export initialization for new export.
- ;
- INFORM ;EP - INFORM OPERATOR WHAT IS GOING TO HAPPEN
- Q:$D(ZTQUEUED)
- W !!,"This routine will generate CHR records to be sent to HQ.",!,"The data transmitted will include everything entered since the last time",!,"data was exported up until yesterday."
- W !,"You may ""^"" out at any prompt and will be",!,"ask to confirm your entries prior to generating transactions."
- Q
- ;
- CURRUN ;EP - COMPUTE DATES FOR CURRENT RUN
- S BCH("RUN BEGIN")=""
- I BCH("LAST LOG") S X1=$P(^BCHXLOG(BCH("LAST LOG"),0),U,2),X2=1 D C^%DTC S BCH("RUN BEGIN")=X,Y=X D DD^%DT
- I BCH("RUN BEGIN")="" D FIRSTRUN
- Q:BCH("QFLG")
- S X1=DT,X2=-1 D C^%DTC S Y=X
- I Y<BCH("RUN BEGIN") W:'$D(ZTQUEUED) !!," Ending date cannot be before beginning date!",$C(7) S BCH("QFLG")=18 Q
- S BCH("RUN END")=Y
- S Y=BCH("RUN BEGIN") X ^DD("DD") S BCH("X")=Y
- S Y=BCH("RUN END") X ^DD("DD") S BCH("Y")=Y
- W:'$D(ZTQUEUED) !!,"The inclusive dates for this run are ",BCH("X")," through ",BCH("Y"),"."
- K %,%H,%I,BCH("RDFN"),BCH("X"),BCH("Y"),BCH("LAST LOG"),BCH("LAST BEGIN"),BCH("Z"),BCH("DATE")
- Q
- ;
- FIRSTRUN ; FIRST RUN EVER (NO LOG ENTRY)
- I $D(ZTQUEUED),$D(BCHO("SCHEDULED")) S BCH("RUN BEGIN")=2950101,BCH("FIRST RUN")=1 Q
- W !!,"No log entry. First run ever assumed.",!
- FRLP ;
- K DIR W ! S DIR(0)="D^::EP",DIR("A")="Enter Beginning Date for this Run" K DA D ^DIR K DIR
- I $D(DIRUT) S BCH("QFLG")=99 Q
- I Y="" S BCH("QFLG")=99 Q
- S BCH("X")=Y
- D DATECHK Q:BCH("QFLG") G:Y="" FRLP
- S BCH("RUN BEGIN")=Y
- S BCH("FIRST RUN")=1
- Q
- ;
- DATECHK ;
- I BCH("X")="^" S BCH("QFLG")=99 Q
- S %DT="PX",X=BCH("X") D ^%DT I X="?" S Y="" Q
- I Y<0!(Y>DT)!(Y=DT) W !!,$S(Y>DT!(Y=DT):" Current or future date not allowed!",1:" Invalid date!"),$C(7) S Y=""
- Q
- ;
- ERRBULL ;ENTRY POINT - ERROR BULLETIN
- Q:BCH("QFLG")=22 ;if error is 22, no visits don't send bulletin
- S BCH("QFLG1")=$O(^BCHDTER("B",BCH("QFLG"),"")),BCH("QFLG DES")=$P(^BCHDTER(BCH("QFLG1"),0),U,2)
- S XMB(2)=BCH("QFLG"),XMB(3)=BCH("QFLG DES")
- S XMB(4)=$S($D(BCH("RUN LOG")):BCH("RUN LOG"),1:"< NONE >")
- I '$D(BCH("RUN BEGIN")) S XMB(5)="<UNKNOWN>" G ERRBULL1
- S Y=BCH("RUN BEGIN") D DD^%DT S XMB(5)=Y
- ERRBULL1 S Y=DT D DD^%DT S XMB(1)=Y,XMB="BCH CHR TRANSMISSION ERROR"
- S XMDUZ=.5 D ^XMB
- K XMB,XM1,XMA,XMDT,XMM,BCH("QFLG1"),BCH("QFLG DES"),XMDUZ
- Q
- BCHEXDI3 ; IHS/CMI/LAB - initialization part III ;
- +1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
- +2 ;
- +3 ;CHR export initialization for new export.
- +4 ;
- INFORM ;EP - INFORM OPERATOR WHAT IS GOING TO HAPPEN
- +1 IF $DATA(ZTQUEUED)
- QUIT
- +2 WRITE !!,"This routine will generate CHR records to be sent to HQ.",!,"The data transmitted will include everything entered since the last time",!,"data was exported up until yesterday."
- +3 WRITE !,"You may ""^"" out at any prompt and will be",!,"ask to confirm your entries prior to generating transactions."
- +4 QUIT
- +5 ;
- CURRUN ;EP - COMPUTE DATES FOR CURRENT RUN
- +1 SET BCH("RUN BEGIN")=""
- +2 IF BCH("LAST LOG")
- SET X1=$PIECE(^BCHXLOG(BCH("LAST LOG"),0),U,2)
- SET X2=1
- DO C^%DTC
- SET BCH("RUN BEGIN")=X
- SET Y=X
- DO DD^%DT
- +3 IF BCH("RUN BEGIN")=""
- DO FIRSTRUN
- +4 IF BCH("QFLG")
- QUIT
- +5 SET X1=DT
- SET X2=-1
- DO C^%DTC
- SET Y=X
- +6 IF Y<BCH("RUN BEGIN")
- IF '$DATA(ZTQUEUED)
- WRITE !!," Ending date cannot be before beginning date!",$CHAR(7)
- SET BCH("QFLG")=18
- QUIT
- +7 SET BCH("RUN END")=Y
- +8 SET Y=BCH("RUN BEGIN")
- XECUTE ^DD("DD")
- SET BCH("X")=Y
- +9 SET Y=BCH("RUN END")
- XECUTE ^DD("DD")
- SET BCH("Y")=Y
- +10 IF '$DATA(ZTQUEUED)
- WRITE !!,"The inclusive dates for this run are ",BCH("X")," through ",BCH("Y"),"."
- +11 KILL %,%H,%I,BCH("RDFN"),BCH("X"),BCH("Y"),BCH("LAST LOG"),BCH("LAST BEGIN"),BCH("Z"),BCH("DATE")
- +12 QUIT
- +13 ;
- FIRSTRUN ; FIRST RUN EVER (NO LOG ENTRY)
- +1 IF $DATA(ZTQUEUED)
- IF $DATA(BCHO("SCHEDULED"))
- SET BCH("RUN BEGIN")=2950101
- SET BCH("FIRST RUN")=1
- QUIT
- +2 WRITE !!,"No log entry. First run ever assumed.",!
- FRLP ;
- +1 KILL DIR
- WRITE !
- SET DIR(0)="D^::EP"
- SET DIR("A")="Enter Beginning Date for this Run"
- KILL DA
- DO ^DIR
- KILL DIR
- +2 IF $DATA(DIRUT)
- SET BCH("QFLG")=99
- QUIT
- +3 IF Y=""
- SET BCH("QFLG")=99
- QUIT
- +4 SET BCH("X")=Y
- +5 DO DATECHK
- IF BCH("QFLG")
- QUIT
- IF Y=""
- GOTO FRLP
- +6 SET BCH("RUN BEGIN")=Y
- +7 SET BCH("FIRST RUN")=1
- +8 QUIT
- +9 ;
- DATECHK ;
- +1 IF BCH("X")="^"
- SET BCH("QFLG")=99
- QUIT
- +2 SET %DT="PX"
- SET X=BCH("X")
- DO ^%DT
- IF X="?"
- SET Y=""
- QUIT
- +3 IF Y<0!(Y>DT)!(Y=DT)
- WRITE !!,$SELECT(Y>DT!(Y=DT):" Current or future date not allowed!",1:" Invalid date!"),$CHAR(7)
- SET Y=""
- +4 QUIT
- +5 ;
- ERRBULL ;ENTRY POINT - ERROR BULLETIN
- +1 ;if error is 22, no visits don't send bulletin
- IF BCH("QFLG")=22
- QUIT
- +2 SET BCH("QFLG1")=$ORDER(^BCHDTER("B",BCH("QFLG"),""))
- SET BCH("QFLG DES")=$PIECE(^BCHDTER(BCH("QFLG1"),0),U,2)
- +3 SET XMB(2)=BCH("QFLG")
- SET XMB(3)=BCH("QFLG DES")
- +4 SET XMB(4)=$SELECT($DATA(BCH("RUN LOG")):BCH("RUN LOG"),1:"< NONE >")
- +5 IF '$DATA(BCH("RUN BEGIN"))
- SET XMB(5)="<UNKNOWN>"
- GOTO ERRBULL1
- +6 SET Y=BCH("RUN BEGIN")
- DO DD^%DT
- SET XMB(5)=Y
- ERRBULL1 SET Y=DT
- DO DD^%DT
- SET XMB(1)=Y
- SET XMB="BCH CHR TRANSMISSION ERROR"
- +1 SET XMDUZ=.5
- DO ^XMB
- +2 KILL XMB,XM1,XMA,XMDT,XMM,BCH("QFLG1"),BCH("QFLG DES"),XMDUZ
- +3 QUIT
