BCHRPTU.m

BCHRPTU ; IHS/CMI/LAB - REPORT UTILITIES ; 

 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 ;

 ;

DIQ ;

 K BCHPRNT,BCHFILE,BCHFIEL

 S BCHFILE=$P($P(^BCHSORT(BCHCRIT,0),U,4),","),BCHFIEL=$P($P(^(0),U,4),",",2)

 S DIQ(0)="EN",DIQ="BCHPRNT(",DIC=BCHFILE,DR=BCHFIEL D EN^DIQ1 K DIC,DR,DIQ

 I '$D(BCHPRNT(BCHFILE,DA,BCHFIEL,"E")) S BCHPRNT(BCHFILE,DA,BCHFIEL,"E")="--"

 S BCHPRNT=BCHPRNT(BCHFILE,DA,BCHFIEL,"E")

 Q

PAUSE ;EP

 Q:$E(IOST)'="C"!(IO'=IO(0))

 W ! S DIR(0)="EO",DIR("A")="Hit return to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q

XIT ;EP

BCHRPTU   ; IHS/CMI/LAB - REPORT UTILITIES ; 

 +1       ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27

 +2       ;

 +3       ;

DIQ       ;

 +1        KILL BCHPRNT,BCHFILE,BCHFIEL

 +2        SET BCHFILE=$PIECE($PIECE(^BCHSORT(BCHCRIT,0),U,4),",")

           SET BCHFIEL=$PIECE($PIECE(^(0),U,4),",",2)

 +3        SET DIQ(0)="EN"

           SET DIQ="BCHPRNT("

           SET DIC=BCHFILE

           SET DR=BCHFIEL

           DO EN^DIQ1

           KILL DIC,DR,DIQ

 +4        IF '$DATA(BCHPRNT(BCHFILE,DA,BCHFIEL,"E"))

               SET BCHPRNT(BCHFILE,DA,BCHFIEL,"E")="--"

 +5        SET BCHPRNT=BCHPRNT(BCHFILE,DA,BCHFIEL,"E")

 +6        QUIT 

PAUSE     ;EP

 +1        IF $EXTRACT(IOST)'="C"!(IO'=IO(0))

               QUIT 

 +2        WRITE !

           SET DIR(0)="EO"

           SET DIR("A")="Hit return to continue...."

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        QUIT 

XIT       ;EP