BCHUAR ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED 16-AUG-1994 12 Apr 2006 10:24 AM ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;; ;
START ; Write Header
D EN^BCHUEKL ; -- kill all vars before starting
D EN^XBVK("BCH") ;IHS/CMI/TMJ PATCH #16 Variable Kill
START1 W:$D(IOF) @IOF
F J=1:1:5 S X=$P($T(TEXT+J),";;",2) W !?80-$L(X)\2,X
K X,J
W !!
D ^BCHUIN ;Initialize vars, etc.
;loop through until user wants to quit
S BCHPROV="" D GETPROV I BCHPROV S BCHPROG="" D GETPROG I BCHPROG]"" S BCHDATE="" D GETDATE I BCHDATE D EN,FULL^VALM1,EXIT
D EOJ
Q
;
RNS ;EP
D EN^BCHUEKL
D EN^XBVK("BCH")
S BCHRNS=1
G START1
UP1 ;
D EN^BCHUEKL
D EN^XBVK("BCH")
S BCHF2=1
G START1
ABB ;EP
D EN^XBVK("BCH")
D EN^BCHUEKL
S BCHUABFO=1
G START1
EOJ ;EOJ CLEANUP
D ^BCHUEKL
K BCHRNS
Q
GETDATE ;EP GET DATE OF ENCOUNTER
G TEST
S BCHDATE="",DIR(0)="DO^:"_DT_":EPT",DIR("A")="Enter DATE OF SERVICE" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
S %DT="ET" D ^%DT G:Y<0 GETDATE
I Y>DT W " <Future dates not allowed>",$C(7),$C(7) K X G GETDATE
S BCHDATE=Y
D DD^%DT
;
TEST ;EP
S BCHDATE="",DIR(0)="90002,.01O",DIR("A")="Enter DATE OF SERVICE" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
S %DT="ET" D ^%DT G:Y<0 GETDATE
I Y>DT W " <Future dates not allowed>",$C(7),$C(7) K X G GETDATE
S BCHDATE=Y
D DD^%DT
Q
GETPROV ;EP - GET PROVIDER
S BCHPROV="",DIR(0)="90002,.03O",DIR("A")="Enter Provider (CHR)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
Q:Y=""
S BCHPROV=+Y
Q
;
GETPROG ;
S BCHPROG=""
K DIR,X,Y,DA S DIR(0)="90002,.02O",DIR("A")="Enter CHR PROGRAM" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
S BCHPROG=Y,BCHPROG(0)=$P(Y(0),U)
Q
EN ; EP -- main entry point for BCH UPDATE ACTIVITY RECORDS
D TERM^VALM0
S VALMCC=1
D EN^VALM("BCH UPDATE ACTIVITY RECORDS")
D CLEAR^VALM1
Q
;
HDR ; EP -- header code
S VALMHDR(1)=BCHDASH
S VALMHDR(2)="Date of Encounter: "_$$FTIME^VALM1(BCHDATE)_" Program: "_BCHPROG(0)
S VALMHDR(3)="Provider (CHR): "_$P(^VA(200,BCHPROV,0),U)
S VALMHDR(4)=BCHDASH
I $E($G(BCHVRECS(1,0)))="N" S BCHRCNT=0,VALMHDR(5)=BCHVRECS(1,0) K BCHVRECS
E S VALMHDR(5)=" # PATIENT NAME HRN/CHR ID ASSESSMENT LOC TRAVEL"
Q
;
INIT ; -- init variables and list array
D GATHER^BCHUARL ;gather up all records for display
S VALMCNT=BCHRCNT
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K BCHRCNT,BCHVRECS
K VALMCC,VALMHDR,VALMBCK,VALMCNT
Q
;
EXPND ; -- expand code
Q
;
TEXT ;
;;CHR Data Entry Module
;;
;;************************
;;* Update CHR Records *
;;************************
;;
Q
BCHUAR ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED 16-AUG-1994 12 Apr 2006 10:24 AM ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;; ;
START ; Write Header
+1 ; -- kill all vars before starting
DO EN^BCHUEKL
+2 ;IHS/CMI/TMJ PATCH #16 Variable Kill
DO EN^XBVK("BCH")
START1 IF $DATA(IOF)
WRITE @IOF
+1 FOR J=1:1:5
SET X=$PIECE($TEXT(TEXT+J),";;",2)
WRITE !?80-$LENGTH(X)\2,X
+2 KILL X,J
+3 WRITE !!
+4 ;Initialize vars, etc.
DO ^BCHUIN
+5 ;loop through until user wants to quit
+6 SET BCHPROV=""
DO GETPROV
IF BCHPROV
SET BCHPROG=""
DO GETPROG
IF BCHPROG]""
SET BCHDATE=""
DO GETDATE
IF BCHDATE
DO EN
DO FULL^VALM1
DO EXIT
+7 DO EOJ
+8 QUIT
+9 ;
RNS ;EP
+1 DO EN^BCHUEKL
+2 DO EN^XBVK("BCH")
+3 SET BCHRNS=1
+4 GOTO START1
UP1 ;
+1 DO EN^BCHUEKL
+2 DO EN^XBVK("BCH")
+3 SET BCHF2=1
+4 GOTO START1
ABB ;EP
+1 DO EN^XBVK("BCH")
+2 DO EN^BCHUEKL
+3 SET BCHUABFO=1
+4 GOTO START1
EOJ ;EOJ CLEANUP
+1 DO ^BCHUEKL
+2 KILL BCHRNS
+3 QUIT
GETDATE ;EP GET DATE OF ENCOUNTER
+1 GOTO TEST
+2 SET BCHDATE=""
SET DIR(0)="DO^:"_DT_":EPT"
SET DIR("A")="Enter DATE OF SERVICE"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
QUIT
+4 SET %DT="ET"
DO ^%DT
IF Y<0
GOTO GETDATE
+5 IF Y>DT
WRITE " <Future dates not allowed>",$CHAR(7),$CHAR(7)
KILL X
GOTO GETDATE
+6 SET BCHDATE=Y
+7 DO DD^%DT
+8 ;
TEST ;EP
+1 SET BCHDATE=""
SET DIR(0)="90002,.01O"
SET DIR("A")="Enter DATE OF SERVICE"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
QUIT
+3 SET %DT="ET"
DO ^%DT
IF Y<0
GOTO GETDATE
+4 IF Y>DT
WRITE " <Future dates not allowed>",$CHAR(7),$CHAR(7)
KILL X
GOTO GETDATE
+5 SET BCHDATE=Y
+6 DO DD^%DT
+7 QUIT
GETPROV ;EP - GET PROVIDER
+1 SET BCHPROV=""
SET DIR(0)="90002,.03O"
SET DIR("A")="Enter Provider (CHR)"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
QUIT
+3 IF Y=""
QUIT
+4 SET BCHPROV=+Y
+5 QUIT
+6 ;
GETPROG ;
+1 SET BCHPROG=""
+2 KILL DIR,X,Y,DA
SET DIR(0)="90002,.02O"
SET DIR("A")="Enter CHR PROGRAM"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
QUIT
+4 SET BCHPROG=Y
SET BCHPROG(0)=$PIECE(Y(0),U)
+5 QUIT
EN ; EP -- main entry point for BCH UPDATE ACTIVITY RECORDS
+1 DO TERM^VALM0
+2 SET VALMCC=1
+3 DO EN^VALM("BCH UPDATE ACTIVITY RECORDS")
+4 DO CLEAR^VALM1
+5 QUIT
+6 ;
HDR ; EP -- header code
+1 SET VALMHDR(1)=BCHDASH
+2 SET VALMHDR(2)="Date of Encounter: "_$$FTIME^VALM1(BCHDATE)_" Program: "_BCHPROG(0)
+3 SET VALMHDR(3)="Provider (CHR): "_$PIECE(^VA(200,BCHPROV,0),U)
+4 SET VALMHDR(4)=BCHDASH
+5 IF $EXTRACT($GET(BCHVRECS(1,0)))="N"
SET BCHRCNT=0
SET VALMHDR(5)=BCHVRECS(1,0)
KILL BCHVRECS
+6 IF '$TEST
SET VALMHDR(5)=" # PATIENT NAME HRN/CHR ID ASSESSMENT LOC TRAVEL"
+7 QUIT
+8 ;
INIT ; -- init variables and list array
+1 ;gather up all records for display
DO GATHER^BCHUARL
+2 SET VALMCNT=BCHRCNT
+3 QUIT
+4 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL BCHRCNT,BCHVRECS
+2 KILL VALMCC,VALMHDR,VALMBCK,VALMCNT
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
TEXT ;
+1 ;;CHR Data Entry Module
+2 ;;
+3 ;;************************
+4 ;;* Update CHR Records *
+5 ;;************************
+6 ;;
+7 QUIT
