- 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 Feb 19, 2025@00:24:42 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