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

DGRUPAR.m

Go to the documentation of this file.
  1. DGRUPAR ; ALB/SCK - RAI/MDS PARAMETER ENTRY/EDIT ; 13 OCT 99
  1. ;;5.3;Registration;**190**;Aug 13, 1993
  1. ;
  1. WR ;
  1. N DGHEAD,DGMULT,DGX
  1. ;
  1. S U="^",DGHEAD="RAI/MDS COTS PARAMETER ENTRY/EDIT",IOP="HOME" D ^%ZIS K IOP
  1. W @IOF,!?22,DGHEAD,! S X="",$P(X,"=",79)="" W X
  1. ;
  1. S DGMULT=$$GET1^DIQ(43,1,11,"I")
  1. ;
  1. W !?4,"Send HL7 V2.3 Messages : ",$$GET1^DIQ(43,1,391.7013),!
  1. S DGX=$$GET1^DIQ(43,1,391.705)
  1. W !,"[1] RAI Integrated Site : ",$S(DGX]"":DGX,1:"NO")
  1. W !?4,"Create Master File Updates : ",$$GET1^DIQ(43,1,391.7014)
  1. ;
  1. DIVSN ;
  1. N DGI
  1. W !!,"[2]" I DGMULT W ?4,"Divisions: "
  1. 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
  1. ;
  1. EDT ;
  1. W !
  1. S DIR(0)="FAO"
  1. S DIR("A")="Enter "_$S(DGMULT:"'D' to view DIVISIONS, ",1:"")_"1-2 to EDIT, or RETURN to QUIT: "
  1. D ^DIR K DIR
  1. Q:$D(DIRUT)
  1. I "dD"[Y D DIV
  1. I Y?1N D @Y
  1. ;D CONT
  1. G WR
  1. Q
  1. ;
  1. DIV ;
  1. N DGDIV
  1. D DGHDV
  1. F DGDIV=0:0 S DGDIV=$O(^DG(40.8,DGDIV)) Q:'DGDIV D
  1. . S DGD=$$GET1^DIQ(40.8,DGDIV,.01)
  1. . W !,DGD,! S X="",$P(X,"-",$L(DGD))="" W X
  1. . W !?4,"RAI Subscription Registry : ",$$GET1^DIQ(40.8,DGDIV,900.01),!
  1. . I ($Y+8)>IOSL D
  1. . . D CONT,DGHDV
  1. Q
  1. ;
  1. 1 ;
  1. N DIE,DA
  1. ;
  1. S DIE=43,DA=1,DR="[DGRAI]"
  1. D ^DIE K DIE
  1. Q
  1. ;
  1. 2 ;
  1. N DIE,DIC,DR,DA
  1. ;
  1. I 'DGMULT D
  1. . S DGDIV=$$GET1^DIQ(43,1,12,"I")
  1. . S DIE=40.8,DR="900.01;"
  1. . D ^DIE K DIE
  1. ;
  1. I DGMULT D
  1. . S DIC=40.8,DIC(0)="AEQM" D ^DIC Q:Y'>0
  1. . S DIE=DIC,DA=+Y,DR="900.01;" D ^DIE K DIE
  1. Q
  1. ;
  1. DGHDV ;
  1. W @IOF,!,"Division RAI/MDS Parameters",! S X="",$P(X,"=",79)="" W X
  1. Q
  1. ;
  1. CONT S DIR(0)="FAO",DIR("A")="Press any key to continue" D ^DIR K DIR
  1. Q