ADEDQUE.m

ADEDQUE ; IHS/HQT/MJL  - DEQUEUES FROM ^ADEPOST ;12:29 PM  [ 03/24/1999   9:04 AM ]

 ;;6.0;ADE;;APRIL 1999

INIT D ^XBKVAR S X="ERR^ADEDQUE",@^%ZOSF("TRAP"),ADEDQ1=0

CTRL F ADEDQ=0:0 D ROLL Q:'+ADEDQ1  S ADEQIT=0 D DQ1 Q:ADEQIT  D ZTM^ADEGRL6,UNLOCK D DQKILL

 G:ADEQIT E1

END K ADEDQ,ADEDQ1,ADEDQNOD

 K ^ADEUTL("ADEDQUE")

E1 D DQKILL

 I $D(ZTQUEUED) S ZTREQ="@"

 Q

UNLOCK Q:'$D(ADEDQ1)

 Q:'+ADEDQ1

 K ^ADEPOST(ADEDQ1)

 L -^ADEPOST(ADEDQ1)

 Q

ROLL S ADEDQ1=$O(^ADEPOST(ADEDQ1))

 Q

DQ1 I '$D(^ADEPOST(ADEDQ1)) S ADEQIT=1 Q

 S ADEDQNOD=^ADEPOST(ADEDQ1)

 ;I $P(ADEDQNOD,U) H 2 G DQ1

 L +^ADEPOST(ADEDQ1):.1 I '$T S ADEQIT=1 Q

 ;S $P(^ADEPOST(ADEDQ1),U)=1

 S ADENEWVS=$P(ADEDQNOD,U,2)

 S ADEPAT=$P(ADEDQNOD,U,3)

 S:$P(ADEDQNOD,U,4) ADEDFN=$P(ADEDQNOD,U,4)

 S ADELOED=$P(ADEDQNOD,U,5)

 S ADEPVNMD=$P(ADEDQNOD,U,6)

 S ADENOTE=$P(ADEDQNOD,U,7)

 S ADERDNMD=$P(ADEDQNOD,U,8)

 S ADEVDATE=$P(ADEDQNOD,U,9)

 S ADECON=$P(ADEDQNOD,U,10)

 S ADEDIR=$P(ADEDQNOD,U,11)

 S ADETCH=$P(ADEDQNOD,U,12)

 S ADEJ=0 F ADEDQ=0:0 S ADEJ=$O(^ADEPOST(ADEDQ1,ADEJ)) Q:ADEJ']""  S ADEV(ADEJ)=^ADEPOST(ADEDQ1,ADEJ)

 Q

DQKILL K ADENEWVS,ADEPAT,ADEDFN,ADELOED,ADEPVNMD,ADENOTE,ADERDNMD,ADEVDATE,ADECON,ADEDIR,ADETCH,ADEV

 Q

ERR ;ERROR TRAP

 S XMB(1)=ADEPAT,XMB(2)=ADEVDATE,XMB="ADEQUE",XMDUZ="DENTAL BACKGROUND JOB" D ^XMB

 K ^ADEPOST(ADEDQ1)

 K ^ADEUTL("ADELOCK",ADEPAT)

 D DQKILL

 D ^%ET

 S X="ERR^ADEDQUE",@^%ZOSF("TRAP")

 G CTRL

ADEDQUE   ; IHS/HQT/MJL  - DEQUEUES FROM ^ADEPOST ;12:29 PM  [ 03/24/1999   9:04 AM ]

 +1       ;;6.0;ADE;;APRIL 1999

INIT       DO ^XBKVAR

           SET X="ERR^ADEDQUE"

           SET @^%ZOSF("TRAP")

           SET ADEDQ1=0

CTRL       FOR ADEDQ=0:0

               DO ROLL

               IF '+ADEDQ1

                   QUIT 

               SET ADEQIT=0

               DO DQ1

               IF ADEQIT

                   QUIT 

               DO ZTM^ADEGRL6

               DO UNLOCK

               DO DQKILL

 +1        IF ADEQIT

               GOTO E1

END        KILL ADEDQ,ADEDQ1,ADEDQNOD

 +1        KILL ^ADEUTL("ADEDQUE")

E1         DO DQKILL

 +1        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +2        QUIT 

UNLOCK     IF '$DATA(ADEDQ1)

               QUIT 

 +1        IF '+ADEDQ1

               QUIT 

 +2        KILL ^ADEPOST(ADEDQ1)

 +3        LOCK -^ADEPOST(ADEDQ1)

 +4        QUIT 

ROLL       SET ADEDQ1=$ORDER(^ADEPOST(ADEDQ1))

 +1        QUIT 

DQ1        IF '$DATA(^ADEPOST(ADEDQ1))

               SET ADEQIT=1

               QUIT 

 +1        SET ADEDQNOD=^ADEPOST(ADEDQ1)

 +2       ;I $P(ADEDQNOD,U) H 2 G DQ1

 +3        LOCK +^ADEPOST(ADEDQ1):.1

           IF '$TEST

               SET ADEQIT=1

               QUIT 

 +4       ;S $P(^ADEPOST(ADEDQ1),U)=1

 +5        SET ADENEWVS=$PIECE(ADEDQNOD,U,2)

 +6        SET ADEPAT=$PIECE(ADEDQNOD,U,3)

 +7        IF $PIECE(ADEDQNOD,U,4)

               SET ADEDFN=$PIECE(ADEDQNOD,U,4)

 +8        SET ADELOED=$PIECE(ADEDQNOD,U,5)

 +9        SET ADEPVNMD=$PIECE(ADEDQNOD,U,6)

 +10       SET ADENOTE=$PIECE(ADEDQNOD,U,7)

 +11       SET ADERDNMD=$PIECE(ADEDQNOD,U,8)

 +12       SET ADEVDATE=$PIECE(ADEDQNOD,U,9)

 +13       SET ADECON=$PIECE(ADEDQNOD,U,10)

 +14       SET ADEDIR=$PIECE(ADEDQNOD,U,11)

 +15       SET ADETCH=$PIECE(ADEDQNOD,U,12)

 +16       SET ADEJ=0

           FOR ADEDQ=0:0

               SET ADEJ=$ORDER(^ADEPOST(ADEDQ1,ADEJ))

               IF ADEJ']""

                   QUIT 

               SET ADEV(ADEJ)=^ADEPOST(ADEDQ1,ADEJ)

 +17       QUIT 

DQKILL     KILL ADENEWVS,ADEPAT,ADEDFN,ADELOED,ADEPVNMD,ADENOTE,ADERDNMD,ADEVDATE,ADECON,ADEDIR,ADETCH,ADEV

 +1        QUIT 

ERR       ;ERROR TRAP

 +1        SET XMB(1)=ADEPAT

           SET XMB(2)=ADEVDATE

           SET XMB="ADEQUE"

           SET XMDUZ="DENTAL BACKGROUND JOB"

           DO ^XMB

 +2        KILL ^ADEPOST(ADEDQ1)

 +3        KILL ^ADEUTL("ADELOCK",ADEPAT)

 +4        DO DQKILL

 +5        DO ^%ET

 +6        SET X="ERR^ADEDQUE"

           SET @^%ZOSF("TRAP")

 +7        GOTO CTRL