Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFDHRD

ACRFDHRD.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1.  ;This routine is used to enter/edit DHR data in the DHR Data Records
  1.  ;file
  1.  ;
  1. EN ;EP -- ENTER/EDIT MAIN ENTRY POINT
  1.  ;
  1.  N ACRADD,ACRCLR,ACRD0,ACRD1,ACRD2,ACRD3,ACRDR,ACRDUP,ACROUT,ACRTYPE,ACROPT,DIR,X,Y
  1.  D HOME^%ZIS
  1.  D ^XBKVAR
  1.  S (ACRDUP,ACROUT)=0
  1.  S ACRADD=1
  1.  D OPT^ACRFDHRE(.ACROPT,.ACROUT)
  1.  Q:$G(ACROUT)
  1.  D DISPLAY(ACROPT)
  1.  D RB^ACRFDHRE(.ACRCLR)
  1.  G EN:$G(ACROUT)
  1.  D SEL^ACRFDHRE(.ACRD0,.ACRD1,.ACRD2,.ACROUT,ACRADD,ACROPT,.ACRCLR)
  1.  G EN:$G(ACROUT)
  1.  S DATA=$G(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0))
  1.  I $P(DATA,U,4)!($P(DATA,U,9)) D  G EN
  1.  . W *7,"This batch has been exported" H 2
  1.  I $P(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0),U,3)="C" D
  1.  . N DIR
  1.  . W *7
  1.  . S DIR(0)="Y"
  1.  . S DIR("A")="This batch is closed, do you still want to add records"
  1.  . S DIR("B")="NO"
  1.  . D ^DIR
  1.  . Q:'Y
  1.  . D REOPEN^ACRFDHRE(ACRD0,ACRD1,ACRD2)
  1.  I $P(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0),U,3)="C" G EN
  1.  K Y
  1.  D TYPE^ACRFDHRE(.Y) ;Don't need this with 650 DHR
  1.  G EN:Y']"" ;Don't need this with 650 DHR
  1.  S ACRTYPE=Y ;Don't need this with 650 DHR
  1.  I ACRTYPE=4 D TRAIL^ACRFDHRE(ACRD0,ACRD1,ACRD2) G EN ;Don't need this with 650 DHR
  1.  F  D  Q:ACROUT
  1.  . K ACRD3
  1.  . D SEQ^ACRFDHRE(ACRD0,ACRD1,ACRD2,.ACRDR,ACRADD,.Y)
  1.  . I Y'>0 S ACROUT=1 Q
  1.  . S ACRD3=+Y
  1.  . D EDIT^ACRFDHRE(ACRD0,ACRD1,ACRD2,ACRD3,ACRTYPE)
  1.  . D DEL^ACRFDHRE(ACRD0,ACRD1,ACRD2,ACRD3,ACRTYPE)
  1.  . D ADDFMS^ACRFDHRE(ACRD0,ACRD1,ACRD2,ACRD3,"M")
  1.  . D DUPE^ACRFDHRE(ACRD0,ACRD1,ACRD2,ACRD3,.ACRDUP,.ACRDR)
  1.  G EN
  1.  Q
  1. DISPLAY(ACROPT)    ;EP
  1.  ;----- DISPLAY RECORD BATCHES
  1.  ;   
  1.  N ACRD0,ACRD1,ACRD2,ACRD3,CNT,DATA,I
  1.  K ^TMP("ACRDHR",$J)
  1.  F ACRD0=$P(ACROPT,U):1:$P(ACROPT,U,2) D
  1.  . S ACRD1=0
  1.  . F  S ACRD1=$O(^AFSHRCDS(ACRD0,"D",ACRD1)) Q:'ACRD1  D
  1.  . . S ACRD2=0
  1.  . . F  S ACRD2=$O(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2)) Q:'ACRD2  D
  1.  . . . S DATA=$G(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0))
  1.  . . . Q:DATA']""
  1.  . . . S (ACRD3,CNT)=0
  1.  . . . F  S ACRD3=$O(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3)) Q:'ACRD3  D
  1.  . . . . S CNT=CNT+1
  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)
  1.  Q:'$D(^TMP("ACRDHR",$J))
  1.  W @IOF
  1.  W !,"TYPE COLOR",?15,"DATE",?27,"ID",?34,"RCD",?42,"STATUS",?63,"650DHREXP DT"
  1.  W !
  1.  F I=1:1:80 W "-"
  1.  W !
  1.  S ACRD0=0
  1.  F  S ACRD0=$O(^TMP("ACRDHR",$J,ACRD0)) Q:'ACRD0  D
  1.  . 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:"")
  1.  . S ACRD1=0 F  S ACRD1=$O(^TMP("ACRDHR",$J,ACRD0,ACRD1)) Q:'ACRD1  D
  1.  . . S ACRD2=""
  1.  . . F  S ACRD2=$O(^TMP("ACRDHR",$J,ACRD0,ACRD1,ACRD2)) Q:ACRD2']""  D
  1.  . . . S DATA=^TMP("ACRDHR",$J,ACRD0,ACRD1,ACRD2)
  1.  . . . W ?15,$$DATE^ACRFDHRE(ACRD1)
  1.  . . . W ?27,ACRD2
  1.  . . . W ?32,$J($P(DATA,U),5)
  1.  . . . W ?42,$S($P(DATA,U,2)="C":"CLOSED",1:"OPEN")
  1.  . . . W ?63,$$DATE^ACRFDHRE($P(DATA,U,4))
  1.  . . . W !
  1.  K ^TMP("ACRDHR",$J)
  1.  Q