DGPTBE2 ;ALB/AS - ENTER BREAKEVEN VALUES FOR DRG (cont.); 28 APR 88 @ 0900
;;5.3;Registration;;Aug 13, 1993
;
S DIE="^ICD(",DA=DRG,DR="13///"_DGBE D ^DIE
I 'DGY F DGQRTR=1:1:4 S (DA,DGFY1)=DGFY_DGQRTR,DGBE=$P(DGVALUES,"^",6) D DIE
I DGY S (DA,DGFY1)=DGFY D DIE
K DGFY1,DGQRTR,DA,DIE,DR,DO Q
DIE S DIE="^ICD("_DRG_",""BE"",",DA(1)=DRG I '$D(^ICD(DRG,"BE",DA,0)) S DR=".01////"_DA D ^DIE
S DR="2///"_DGBE D ^DIE F DGSV=1:1:5 S DGBE=$P(DGVALUES,"^",DGSV),DA(2)=DRG,DA(1)=DGFY1,DA=DGSV,DIE="^ICD("_DRG_",""BE"","_DGFY1_",""S""," D:'$D(^ICD(DRG,"BE",DA(1),"S",DGSV,0)) ADD S DR="1///"_DGBE D ^DIE
Q
ADD S DR=".01////"_DA D ^DIE Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTBE2 645 printed Oct 16, 2024@18:52:19 Page 2
DGPTBE2 ;ALB/AS - ENTER BREAKEVEN VALUES FOR DRG (cont.); 28 APR 88 @ 0900
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;
+3 SET DIE="^ICD("
SET DA=DRG
SET DR="13///"_DGBE
DO ^DIE
+4 IF 'DGY
FOR DGQRTR=1:1:4
SET (DA,DGFY1)=DGFY_DGQRTR
SET DGBE=$PIECE(DGVALUES,"^",6)
DO DIE
+5 IF DGY
SET (DA,DGFY1)=DGFY
DO DIE
+6 KILL DGFY1,DGQRTR,DA,DIE,DR,DO
QUIT
DIE SET DIE="^ICD("_DRG_",""BE"","
SET DA(1)=DRG
IF '$DATA(^ICD(DRG,"BE",DA,0))
SET DR=".01////"_DA
DO ^DIE
+1 SET DR="2///"_DGBE
DO ^DIE
FOR DGSV=1:1:5
SET DGBE=$PIECE(DGVALUES,"^",DGSV)
SET DA(2)=DRG
SET DA(1)=DGFY1
SET DA=DGSV
SET DIE="^ICD("_DRG_",""BE"","_DGFY1_",""S"","
if '$DATA(^ICD(DRG,"BE",DA(1),"S",DGSV,0))
DO ADD
SET DR="1///"_DGBE
DO ^DIE
+2 QUIT
ADD SET DR=".01////"_DA
DO ^DIE
QUIT
