ACRFDHRD ;IHS/OIRM/DSD/AEF - DRIVER ROUTINE FOR DHR ENTER/EDIT [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGMT SYSTEM;;NOV 05, 2001
;
;
;This routine is used to enter/edit DHR data in the DHR Data Records
;file
;
EN ;EP -- ENTER/EDIT MAIN ENTRY POINT
;
N ACRADD,ACRCLR,ACRD0,ACRD1,ACRD2,ACRD3,ACRDR,ACRDUP,ACROUT,ACRTYPE,ACROPT,DIR,X,Y
D HOME^%ZIS
D ^XBKVAR
S (ACRDUP,ACROUT)=0
S ACRADD=1
D OPT^ACRFDHRE(.ACROPT,.ACROUT)
Q:$G(ACROUT)
D DISPLAY(ACROPT)
D RB^ACRFDHRE(.ACRCLR)
G EN:$G(ACROUT)
D SEL^ACRFDHRE(.ACRD0,.ACRD1,.ACRD2,.ACROUT,ACRADD,ACROPT,.ACRCLR)
G EN:$G(ACROUT)
S DATA=$G(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0))
I $P(DATA,U,4)!($P(DATA,U,9)) D G EN
. W *7,"This batch has been exported" H 2
I $P(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0),U,3)="C" D
. N DIR
. W *7
. S DIR(0)="Y"
. S DIR("A")="This batch is closed, do you still want to add records"
. S DIR("B")="NO"
. D ^DIR
. Q:'Y
. D REOPEN^ACRFDHRE(ACRD0,ACRD1,ACRD2)
I $P(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0),U,3)="C" G EN
K Y
D TYPE^ACRFDHRE(.Y) ;Don't need this with 650 DHR
G EN:Y']"" ;Don't need this with 650 DHR
S ACRTYPE=Y ;Don't need this with 650 DHR
I ACRTYPE=4 D TRAIL^ACRFDHRE(ACRD0,ACRD1,ACRD2) G EN ;Don't need this with 650 DHR
F D Q:ACROUT
. K ACRD3
. D SEQ^ACRFDHRE(ACRD0,ACRD1,ACRD2,.ACRDR,ACRADD,.Y)
. I Y'>0 S ACROUT=1 Q
. S ACRD3=+Y
. D EDIT^ACRFDHRE(ACRD0,ACRD1,ACRD2,ACRD3,ACRTYPE)
. D DEL^ACRFDHRE(ACRD0,ACRD1,ACRD2,ACRD3,ACRTYPE)
. D ADDFMS^ACRFDHRE(ACRD0,ACRD1,ACRD2,ACRD3,"M")
. D DUPE^ACRFDHRE(ACRD0,ACRD1,ACRD2,ACRD3,.ACRDUP,.ACRDR)
G EN
Q
DISPLAY(ACROPT) ;EP
;----- DISPLAY RECORD BATCHES
;
N ACRD0,ACRD1,ACRD2,ACRD3,CNT,DATA,I
K ^TMP("ACRDHR",$J)
F ACRD0=$P(ACROPT,U):1:$P(ACROPT,U,2) D
. S ACRD1=0
. F S ACRD1=$O(^AFSHRCDS(ACRD0,"D",ACRD1)) Q:'ACRD1 D
. . S ACRD2=0
. . F S ACRD2=$O(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2)) Q:'ACRD2 D
. . . S DATA=$G(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0))
. . . Q:DATA']""
. . . S (ACRD3,CNT)=0
. . . F S ACRD3=$O(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3)) Q:'ACRD3 D
. . . . S CNT=CNT+1
. . . S ^TMP("ACRDHR",$J,ACRD0,ACRD1,$P(DATA,U))=CNT_U_$P(DATA,U,3)_U_$S($P(DATA,U,4)]"":$P(DATA,U,4),1:$P($G(^AFSHRCDS(ACRD0,0)),U,2))_U_$P(DATA,U,9)
Q:'$D(^TMP("ACRDHR",$J))
W @IOF
W !,"TYPE COLOR",?15,"DATE",?27,"ID",?34,"RCD",?42,"STATUS",?63,"650DHREXP DT"
W !
F I=1:1:80 W "-"
W !
S ACRD0=0
F S ACRD0=$O(^TMP("ACRDHR",$J,ACRD0)) Q:'ACRD0 D
. W $S(ACRD0=1:"PCC-BLUE",ACRD0=2:"PCC-RED",ACRD0=3:"BCBS-BLUE",ACRD0=4:"BCBS-RED",ACRD0=5:"ARMS-BLUE",ACRD0=6:"ARMS-RED",1:"")
. S ACRD1=0 F S ACRD1=$O(^TMP("ACRDHR",$J,ACRD0,ACRD1)) Q:'ACRD1 D
. . S ACRD2=""
. . F S ACRD2=$O(^TMP("ACRDHR",$J,ACRD0,ACRD1,ACRD2)) Q:ACRD2']"" D
. . . S DATA=^TMP("ACRDHR",$J,ACRD0,ACRD1,ACRD2)
. . . W ?15,$$DATE^ACRFDHRE(ACRD1)
. . . W ?27,ACRD2
. . . W ?32,$J($P(DATA,U),5)
. . . W ?42,$S($P(DATA,U,2)="C":"CLOSED",1:"OPEN")
. . . W ?63,$$DATE^ACRFDHRE($P(DATA,U,4))
. . . W !
K ^TMP("ACRDHR",$J)
Q
ACRFDHRD ;IHS/OIRM/DSD/AEF - DRIVER ROUTINE FOR DHR ENTER/EDIT [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGMT SYSTEM;;NOV 05, 2001
+2 ;
+3 ;
+4 ;This routine is used to enter/edit DHR data in the DHR Data Records
+5 ;file
+6 ;
EN ;EP -- ENTER/EDIT MAIN ENTRY POINT
+1 ;
+2 NEW ACRADD,ACRCLR,ACRD0,ACRD1,ACRD2,ACRD3,ACRDR,ACRDUP,ACROUT,ACRTYPE,ACROPT,DIR,X,Y
+3 DO HOME^%ZIS
+4 DO ^XBKVAR
+5 SET (ACRDUP,ACROUT)=0
+6 SET ACRADD=1
+7 DO OPT^ACRFDHRE(.ACROPT,.ACROUT)
+8 IF $GET(ACROUT)
QUIT
+9 DO DISPLAY(ACROPT)
+10 DO RB^ACRFDHRE(.ACRCLR)
+11 IF $GET(ACROUT)
GOTO EN
+12 DO SEL^ACRFDHRE(.ACRD0,.ACRD1,.ACRD2,.ACROUT,ACRADD,ACROPT,.ACRCLR)
+13 IF $GET(ACROUT)
GOTO EN
+14 SET DATA=$GET(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0))
+15 IF $PIECE(DATA,U,4)!($PIECE(DATA,U,9))
Begin DoDot:1
+16 WRITE *7,"This batch has been exported"
HANG 2
End DoDot:1
GOTO EN
+17 IF $PIECE(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0),U,3)="C"
Begin DoDot:1
+18 NEW DIR
+19 WRITE *7
+20 SET DIR(0)="Y"
+21 SET DIR("A")="This batch is closed, do you still want to add records"
+22 SET DIR("B")="NO"
+23 DO ^DIR
+24 IF 'Y
QUIT
+25 DO REOPEN^ACRFDHRE(ACRD0,ACRD1,ACRD2)
End DoDot:1
+26 IF $PIECE(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0),U,3)="C"
GOTO EN
+27 KILL Y
+28 ;Don't need this with 650 DHR
DO TYPE^ACRFDHRE(.Y)
+29 ;Don't need this with 650 DHR
IF Y']""
GOTO EN
+30 ;Don't need this with 650 DHR
SET ACRTYPE=Y
+31 ;Don't need this with 650 DHR
IF ACRTYPE=4
DO TRAIL^ACRFDHRE(ACRD0,ACRD1,ACRD2)
GOTO EN
+32 FOR
Begin DoDot:1
+33 KILL ACRD3
+34 DO SEQ^ACRFDHRE(ACRD0,ACRD1,ACRD2,.ACRDR,ACRADD,.Y)
+35 IF Y'>0
SET ACROUT=1
QUIT
+36 SET ACRD3=+Y
+37 DO EDIT^ACRFDHRE(ACRD0,ACRD1,ACRD2,ACRD3,ACRTYPE)
+38 DO DEL^ACRFDHRE(ACRD0,ACRD1,ACRD2,ACRD3,ACRTYPE)
+39 DO ADDFMS^ACRFDHRE(ACRD0,ACRD1,ACRD2,ACRD3,"M")
+40 DO DUPE^ACRFDHRE(ACRD0,ACRD1,ACRD2,ACRD3,.ACRDUP,.ACRDR)
End DoDot:1
IF ACROUT
QUIT
+41 GOTO EN
+42 QUIT
DISPLAY(ACROPT) ;EP
+1 ;----- DISPLAY RECORD BATCHES
+2 ;
+3 NEW ACRD0,ACRD1,ACRD2,ACRD3,CNT,DATA,I
+4 KILL ^TMP("ACRDHR",$JOB)
+5 FOR ACRD0=$PIECE(ACROPT,U):1:$PIECE(ACROPT,U,2)
Begin DoDot:1
+6 SET ACRD1=0
+7 FOR
SET ACRD1=$ORDER(^AFSHRCDS(ACRD0,"D",ACRD1))
IF 'ACRD1
QUIT
Begin DoDot:2
+8 SET ACRD2=0
+9 FOR
SET ACRD2=$ORDER(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2))
IF 'ACRD2
QUIT
Begin DoDot:3
+10 SET DATA=$GET(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0))
+11 IF DATA']""
QUIT
+12 SET (ACRD3,CNT)=0
+13 FOR
SET ACRD3=$ORDER(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3))
IF 'ACRD3
QUIT
Begin DoDot:4
+14 SET CNT=CNT+1
End DoDot:4
+15 SET ^TMP("ACRDHR",$JOB,ACRD0,ACRD1,$PIECE(DATA,U))=CNT_U_$PIECE(DATA,U,3)_U_$SELECT($PIECE(DATA,U,4)]"":$PIECE(DATA,U,4),1:$PIECE($GET(^AFSHRCDS(ACRD0,0)),U,2))_U_$PIECE(DATA,U,9)
End DoDot:3
End DoDot:2
End DoDot:1
+16 IF '$DATA(^TMP("ACRDHR",$JOB))
QUIT
+17 WRITE @IOF
+18 WRITE !,"TYPE COLOR",?15,"DATE",?27,"ID",?34,"RCD",?42,"STATUS",?63,"650DHREXP DT"
+19 WRITE !
+20 FOR I=1:1:80
WRITE "-"
+21 WRITE !
+22 SET ACRD0=0
+23 FOR
SET ACRD0=$ORDER(^TMP("ACRDHR",$JOB,ACRD0))
IF 'ACRD0
QUIT
Begin DoDot:1
+24 WRITE $SELECT(ACRD0=1:"PCC-BLUE",ACRD0=2:"PCC-RED",ACRD0=3:"BCBS-BLUE",ACRD0=4:"BCBS-RED",ACRD0=5:"ARMS-BLUE",ACRD0=6:"ARMS-RED",1:"")
+25 SET ACRD1=0
FOR
SET ACRD1=$ORDER(^TMP("ACRDHR",$JOB,ACRD0,ACRD1))
IF 'ACRD1
QUIT
Begin DoDot:2
+26 SET ACRD2=""
+27 FOR
SET ACRD2=$ORDER(^TMP("ACRDHR",$JOB,ACRD0,ACRD1,ACRD2))
IF ACRD2']""
QUIT
Begin DoDot:3
+28 SET DATA=^TMP("ACRDHR",$JOB,ACRD0,ACRD1,ACRD2)
+29 WRITE ?15,$$DATE^ACRFDHRE(ACRD1)
+30 WRITE ?27,ACRD2
+31 WRITE ?32,$JUSTIFY($PIECE(DATA,U),5)
+32 WRITE ?42,$SELECT($PIECE(DATA,U,2)="C":"CLOSED",1:"OPEN")
+33 WRITE ?63,$$DATE^ACRFDHRE($PIECE(DATA,U,4))
+34 WRITE !
End DoDot:3
End DoDot:2
End DoDot:1
+35 KILL ^TMP("ACRDHR",$JOB)
+36 QUIT
