ADGSV.m

ADGSV ; IHS/ADC/PDW/ENM - Scheduled Visit Enter/Edit ; [ 03/25/1999  11:48 AM ]

 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 ;

A ;

 W ! S AUPNLK("ALL")="",X=1

 F  D  Q:X=""!(X=U)

 . S DIC="^ADGAUTH(",DIC(0)="AEMQL",(DLAYGO,DIDEL)=9009013

 . W !! D ^DIC I Y<1 Q

 . L +^ADGAUTH(+Y):3 I '$T D  Q

 .. W !,*7,"SOMEONE ELSE IS UPDATING THIS ENTRY; TRY AGAIN LATER"

 . S DIE="^ADGAUTH(",DR="[ADGAUTH]",(DGX,DA)=+Y

 . D ^DIE L -^ADGAUTH(DGX) S X=1

 K DA,DIC,DIE,Y,X,DR,AUPNLK,DLAYGO,DIDEL,DGX Q

ADGSV     ; IHS/ADC/PDW/ENM - Scheduled Visit Enter/Edit ; [ 03/25/1999  11:48 AM ]

 +1       ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999

 +2       ;

A         ;

 +1        WRITE !

           SET AUPNLK("ALL")=""

           SET X=1

 +2        FOR 

               Begin DoDot:1

 +3                SET DIC="^ADGAUTH("

                   SET DIC(0)="AEMQL"

                   SET (DLAYGO,DIDEL)=9009013

 +4                WRITE !!

                   DO ^DIC

                   IF Y<1

                       QUIT 

 +5                LOCK +^ADGAUTH(+Y):3

                   IF '$TEST

                       Begin DoDot:2

 +6                        WRITE !,*7,"SOMEONE ELSE IS UPDATING THIS ENTRY; TRY AGAIN LATER"

                       End DoDot:2

                       QUIT 

 +7                SET DIE="^ADGAUTH("

                   SET DR="[ADGAUTH]"

                   SET (DGX,DA)=+Y

 +8                DO ^DIE

                   LOCK -^ADGAUTH(DGX)

                   SET X=1

               End DoDot:1

               IF X=""!(X=U)

                   QUIT 

 +9        KILL DA,DIC,DIE,Y,X,DR,AUPNLK,DLAYGO,DIDEL,DGX

           QUIT