- BCHPCCBL ; IHS/CMI/LAB - back load chr visits to PCC ;
- ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
- ;
- ;
- W:$D(IOF) @IOF
- W !!,"This routine will loop through all CHR records for a time frame you specify",!,"and if there is no PCC visit already created it will fire the CHR to PCC",!,"link for that record.",!!
- W !!,"This routine should be used if the PCC link was turned off for some reason",!,"or another.",!!
- GETDATES ;
- S BCHBLCNT=0
- BD ;get beginning date
- W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter BEGINNING Visit Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) G XIT
- S BCHBD=Y
- ED ;get ending date
- W ! S DIR(0)="D^"_BCHBD_":DT:EP",DIR("A")="Enter ENDING Visit Date" S Y=BCHBD D DD^%DT S DIR("B")=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) G BD
- S BCHED=Y
- S X1=BCHBD,X2=-1 D C^%DTC S BCHSD=X
- S DIR(0)="Y",DIR("A")="Are you sure you want to continue",DIR("B")="N" KILL DA D ^DIR KILL DIR
- I $D(DIRUT) D XIT Q
- I 'Y D XIT Q
- PROCESS ;
- F S BCHSD=$O(^BCHR("B",BCHSD)) Q:BCHSD=""!(BCHSD>BCHED) D
- .S BCHR=0 F S BCHR=$O(^BCHR("B",BCHSD,BCHR)) Q:BCHR'=+BCHR D
- ..Q:'$D(^BCHR(BCHR,0))
- ..Q:$P(^BCHR(BCHR,0),U,15)]""
- ..S BCHEV("TYPE")="A"
- ..D PROTOCOL^BCHUADD1
- ..S BCHBLCNT=BCHBLCNT+1
- ..Q
- .Q
- W !!,"All done. ",BCHBLCNT," records were reviewed and processed.",!
- D XIT
- Q
- XIT ;
- D EN^XBVK("BCH")
- Q
- BCHPCCBL ; IHS/CMI/LAB - back load chr visits to PCC ;
- +1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
- +2 ;
- +3 ;
- +4 IF $DATA(IOF)
- WRITE @IOF
- +5 WRITE !!,"This routine will loop through all CHR records for a time frame you specify",!,"and if there is no PCC visit already created it will fire the CHR to PCC",!,"link for that record.",!!
- +6 WRITE !!,"This routine should be used if the PCC link was turned off for some reason",!,"or another.",!!
- GETDATES ;
- +1 SET BCHBLCNT=0
- BD ;get beginning date
- +1 WRITE !
- SET DIR(0)="D^:DT:EP"
- SET DIR("A")="Enter BEGINNING Visit Date"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +2 IF $DATA(DIRUT)
- GOTO XIT
- +3 SET BCHBD=Y
- ED ;get ending date
- +1 WRITE !
- SET DIR(0)="D^"_BCHBD_":DT:EP"
- SET DIR("A")="Enter ENDING Visit Date"
- SET Y=BCHBD
- DO DD^%DT
- SET DIR("B")=Y
- SET Y=""
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +2 IF $DATA(DIRUT)
- GOTO BD
- +3 SET BCHED=Y
- +4 SET X1=BCHBD
- SET X2=-1
- DO C^%DTC
- SET BCHSD=X
- +5 SET DIR(0)="Y"
- SET DIR("A")="Are you sure you want to continue"
- SET DIR("B")="N"
- KILL DA
- DO ^DIR
- KILL DIR
- +6 IF $DATA(DIRUT)
- DO XIT
- QUIT
- +7 IF 'Y
- DO XIT
- QUIT
- PROCESS ;
- +1 FOR
- SET BCHSD=$ORDER(^BCHR("B",BCHSD))
- IF BCHSD=""!(BCHSD>BCHED)
- QUIT
- Begin DoDot:1
- +2 SET BCHR=0
- FOR
- SET BCHR=$ORDER(^BCHR("B",BCHSD,BCHR))
- IF BCHR'=+BCHR
- QUIT
- Begin DoDot:2
- +3 IF '$DATA(^BCHR(BCHR,0))
- QUIT
- +4 IF $PIECE(^BCHR(BCHR,0),U,15)]""
- QUIT
- +5 SET BCHEV("TYPE")="A"
- +6 DO PROTOCOL^BCHUADD1
- +7 SET BCHBLCNT=BCHBLCNT+1
- +8 QUIT
- End DoDot:2
- +9 QUIT
- End DoDot:1
- +10 WRITE !!,"All done. ",BCHBLCNT," records were reviewed and processed.",!
- +11 DO XIT
- +12 QUIT
- XIT ;
- +1 DO EN^XBVK("BCH")
- +2 QUIT