DGRUPAR ; ALB/SCK - RAI/MDS PARAMETER ENTRY/EDIT ; 13 OCT 99
;;5.3;Registration;**190**;Aug 13, 1993
;
WR ;
N DGHEAD,DGMULT,DGX
;
S U="^",DGHEAD="RAI/MDS COTS PARAMETER ENTRY/EDIT",IOP="HOME" D ^%ZIS K IOP
W @IOF,!?22,DGHEAD,! S X="",$P(X,"=",79)="" W X
;
S DGMULT=$$GET1^DIQ(43,1,11,"I")
;
W !?4,"Send HL7 V2.3 Messages : ",$$GET1^DIQ(43,1,391.7013),!
S DGX=$$GET1^DIQ(43,1,391.705)
W !,"[1] RAI Integrated Site : ",$S(DGX]"":DGX,1:"NO")
W !?4,"Create Master File Updates : ",$$GET1^DIQ(43,1,391.7014)
;
DIVSN ;
N DGI
W !!,"[2]" I DGMULT W ?4,"Divisions: "
F DGI=0:0 S DGI=$O(^DG(40.8,DGI)) Q:'DGI S DGX=$P(^(DGI,0),U,1)_$S($P(^(0),U,2)]"":" ("_$P(^(0),U,2)_"), ",1:"") W:$L(DGX)>(65-$X) !?15 W DGX
;
EDT ;
W !
S DIR(0)="FAO"
S DIR("A")="Enter "_$S(DGMULT:"'D' to view DIVISIONS, ",1:"")_"1-2 to EDIT, or RETURN to QUIT: "
D ^DIR K DIR
Q:$D(DIRUT)
I "dD"[Y D DIV
I Y?1N D @Y
;D CONT
G WR
Q
;
DIV ;
N DGDIV
D DGHDV
F DGDIV=0:0 S DGDIV=$O(^DG(40.8,DGDIV)) Q:'DGDIV D
. S DGD=$$GET1^DIQ(40.8,DGDIV,.01)
. W !,DGD,! S X="",$P(X,"-",$L(DGD))="" W X
. W !?4,"RAI Subscription Registry : ",$$GET1^DIQ(40.8,DGDIV,900.01),!
. I ($Y+8)>IOSL D
. . D CONT,DGHDV
Q
;
1 ;
N DIE,DA
;
S DIE=43,DA=1,DR="[DGRAI]"
D ^DIE K DIE
Q
;
2 ;
N DIE,DIC,DR,DA
;
I 'DGMULT D
. S DGDIV=$$GET1^DIQ(43,1,12,"I")
. S DIE=40.8,DR="900.01;"
. D ^DIE K DIE
;
I DGMULT D
. S DIC=40.8,DIC(0)="AEQM" D ^DIC Q:Y'>0
. S DIE=DIC,DA=+Y,DR="900.01;" D ^DIE K DIE
Q
;
DGHDV ;
W @IOF,!,"Division RAI/MDS Parameters",! S X="",$P(X,"=",79)="" W X
Q
;
CONT S DIR(0)="FAO",DIR("A")="Press any key to continue" D ^DIR K DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRUPAR 1721 printed Nov 22, 2024@18:08:39 Page 2
DGRUPAR ; ALB/SCK - RAI/MDS PARAMETER ENTRY/EDIT ; 13 OCT 99
+1 ;;5.3;Registration;**190**;Aug 13, 1993
+2 ;
WR ;
+1 NEW DGHEAD,DGMULT,DGX
+2 ;
+3 SET U="^"
SET DGHEAD="RAI/MDS COTS PARAMETER ENTRY/EDIT"
SET IOP="HOME"
DO ^%ZIS
KILL IOP
+4 WRITE @IOF,!?22,DGHEAD,!
SET X=""
SET $PIECE(X,"=",79)=""
WRITE X
+5 ;
+6 SET DGMULT=$$GET1^DIQ(43,1,11,"I")
+7 ;
+8 WRITE !?4,"Send HL7 V2.3 Messages : ",$$GET1^DIQ(43,1,391.7013),!
+9 SET DGX=$$GET1^DIQ(43,1,391.705)
+10 WRITE !,"[1] RAI Integrated Site : ",$SELECT(DGX]"":DGX,1:"NO")
+11 WRITE !?4,"Create Master File Updates : ",$$GET1^DIQ(43,1,391.7014)
+12 ;
DIVSN ;
+1 NEW DGI
+2 WRITE !!,"[2]"
IF DGMULT
WRITE ?4,"Divisions: "
+3 FOR DGI=0:0
SET DGI=$ORDER(^DG(40.8,DGI))
if 'DGI
QUIT
SET DGX=$PIECE(^(DGI,0),U,1)_$SELECT($PIECE(^(0),U,2)]"":" ("_$PIECE(^(0),U,2)_"), ",1:"")
if $LENGTH(DGX)>(65-$X)
WRITE !?15
WRITE DGX
+4 ;
EDT ;
+1 WRITE !
+2 SET DIR(0)="FAO"
+3 SET DIR("A")="Enter "_$SELECT(DGMULT:"'D' to view DIVISIONS, ",1:"")_"1-2 to EDIT, or RETURN to QUIT: "
+4 DO ^DIR
KILL DIR
+5 if $DATA(DIRUT)
QUIT
+6 IF "dD"[Y
DO DIV
+7 IF Y?1N
DO @Y
+8 ;D CONT
+9 GOTO WR
+10 QUIT
+11 ;
DIV ;
+1 NEW DGDIV
+2 DO DGHDV
+3 FOR DGDIV=0:0
SET DGDIV=$ORDER(^DG(40.8,DGDIV))
if 'DGDIV
QUIT
Begin DoDot:1
+4 SET DGD=$$GET1^DIQ(40.8,DGDIV,.01)
+5 WRITE !,DGD,!
SET X=""
SET $PIECE(X,"-",$LENGTH(DGD))=""
WRITE X
+6 WRITE !?4,"RAI Subscription Registry : ",$$GET1^DIQ(40.8,DGDIV,900.01),!
+7 IF ($Y+8)>IOSL
Begin DoDot:2
+8 DO CONT
DO DGHDV
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
1 ;
+1 NEW DIE,DA
+2 ;
+3 SET DIE=43
SET DA=1
SET DR="[DGRAI]"
+4 DO ^DIE
KILL DIE
+5 QUIT
+6 ;
2 ;
+1 NEW DIE,DIC,DR,DA
+2 ;
+3 IF 'DGMULT
Begin DoDot:1
+4 SET DGDIV=$$GET1^DIQ(43,1,12,"I")
+5 SET DIE=40.8
SET DR="900.01;"
+6 DO ^DIE
KILL DIE
End DoDot:1
+7 ;
+8 IF DGMULT
Begin DoDot:1
+9 SET DIC=40.8
SET DIC(0)="AEQM"
DO ^DIC
if Y'>0
QUIT
+10 SET DIE=DIC
SET DA=+Y
SET DR="900.01;"
DO ^DIE
KILL DIE
End DoDot:1
+11 QUIT
+12 ;
DGHDV ;
+1 WRITE @IOF,!,"Division RAI/MDS Parameters",!
SET X=""
SET $PIECE(X,"=",79)=""
WRITE X
+2 QUIT
+3 ;
CONT SET DIR(0)="FAO"
SET DIR("A")="Press any key to continue"
DO ^DIR
KILL DIR
+1 QUIT
