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

GMRCMSS.m

Go to the documentation of this file.
GMRCMSS ;SLC/DLT,DCM - Setup Request Services ;5/20/98  14:20
 ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
EN ;entry to setup service
 S DIC="^GMR(123.5,",DIC(0)="AELMQZ",DIC("A")="Select Service/Specialty: ",DLAYGO=123.5,GMRCFLG=0 F  D ^DIC Q:Y<1  D EDIT S DIC(0)="AELMQZ"
 I GMRCFLG,$P(^GMR(123.5,1,10,0),"^",4)>30 W !,"<REINDEXING>  One Moment Please..." D
 .S DIK="^GMR(123.5,",DIK(1)=".01^B",DA=1,DA(1)=10 D IX^DIK
 .Q
 D END Q
EDIT S (DA,GMRCS)=+Y,GMRCS(0)=Y(0,0) I $D(^GMR(123,+Y,123)) S GMRCS(123)=^GMR(123,+Y,123)
 S DIE=DIC S DR="[GMRC SETUP REQUEST SERVICE]" D ^DIE K DIE W !
 Q:$O(^GMR(123.5,1,10,"B",GMRCS,0))
 S GMRCMN=$G(^GMR(123.5,GMRCS,2,1,0)),GMRCFLG=1
 S DIE="^GMR(123.5,1,10,",DA=GMRCS,DA(1)=GMRCS,DR=".01////"_GMRCS_";2////"_GMRCMN D ^DIE K DIE,DA,DR
 Q
END K DA,DIC,DIE,DIK,DLAYGO,GMRCFLG,GMRCS,GMRCMN,DR,Y
 Q