APSPCCD.m

APSPCCD ; IHS/DSD/ENM - DELETE PCC RX LINKAGE ;01-Mar-2006 19:07;SM

 ;;7.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 ; NOTE: CALLED FROM PSRXDL

 ;

EN ; NORMAL ENTRY POINT FROM PHARMACY ROUTINES -- TASKMAN SETUP

 G:'APSRM EXIT G:'$D(^AUPNVMED(APSRM,0)) EXIT

 NEW X

 K ZTSAVE F %="APSRX","APSRM","APSPPDFN" S ZTSAVE(%)=""

 S ZTRTN="ZTSK^APSPCCD",ZTDESC="DELETE PRESCRIPTION LINK TO PCC FROM PHARMACY",ZTIO="",ZTDTH=DT D ^%ZTLOAD K ZTSK

EXIT K APSRX,APSRM,ZTRTN,ZTDESC,ZTIO,ZTDTH

 Q

 ;

ZTSK ; TASKMAN ENTRY POINT (IN BACKGROUND)

 D ^APSPCCLQ ; HANG IN QUEUE

 S APSRV=$P(^AUPNVMED(APSRM,0),U,3)

 S:$D(^APSPCCTM) (^APSPCCTM,APSPCCTM)=^APSPCCTM+1,^APSPCCTM(APSPCCTM,1)=$H_"^D"

 S DIE=9000010.14,DA=APSRM,DR=".01///@" D ^DIE ; DELETE V MED ENTRY

 I '$P(^AUPNVSIT(APSRV,0),U,9) S AUPNVSIT=APSRV D DEL^AUPNVSIT

 I $D(APSPCCTM) S ^APSPCCTM(APSPCCTM,2)=$H K APSPCCTM

 D K^APSPCCLQ ; REMOVE QUEUE ENTRY

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

ZTSKX K APSRX,APSRM,APSRV,AUPNVSIT

 Q

APSPCCD   ; IHS/DSD/ENM - DELETE PCC RX LINKAGE ;01-Mar-2006 19:07;SM

 +1       ;;7.0;IHS PHARMACY MODIFICATIONS;;09/03/97

 +2       ; NOTE: CALLED FROM PSRXDL

 +3       ;

EN        ; NORMAL ENTRY POINT FROM PHARMACY ROUTINES -- TASKMAN SETUP

 +1        IF 'APSRM

               GOTO EXIT

           IF '$DATA(^AUPNVMED(APSRM,0))

               GOTO EXIT

 +2        NEW X

 +3        KILL ZTSAVE

           FOR %="APSRX","APSRM","APSPPDFN"

               SET ZTSAVE(%)=""

 +4        SET ZTRTN="ZTSK^APSPCCD"

           SET ZTDESC="DELETE PRESCRIPTION LINK TO PCC FROM PHARMACY"

           SET ZTIO=""

           SET ZTDTH=DT

           DO ^%ZTLOAD

           KILL ZTSK

EXIT       KILL APSRX,APSRM,ZTRTN,ZTDESC,ZTIO,ZTDTH

 +1        QUIT 

 +2       ;

ZTSK      ; TASKMAN ENTRY POINT (IN BACKGROUND)

 +1       ; HANG IN QUEUE

           DO ^APSPCCLQ

 +2        SET APSRV=$PIECE(^AUPNVMED(APSRM,0),U,3)

 +3        IF $DATA(^APSPCCTM)

               SET (^APSPCCTM,APSPCCTM)=^APSPCCTM+1

               SET ^APSPCCTM(APSPCCTM,1)=$HOROLOG_"^D"

 +4       ; DELETE V MED ENTRY

           SET DIE=9000010.14

           SET DA=APSRM

           SET DR=".01///@"

           DO ^DIE

 +5        IF '$PIECE(^AUPNVSIT(APSRV,0),U,9)

               SET AUPNVSIT=APSRV

               DO DEL^AUPNVSIT

 +6        IF $DATA(APSPCCTM)

               SET ^APSPCCTM(APSPCCTM,2)=$HOROLOG

               KILL APSPCCTM

 +7       ; REMOVE QUEUE ENTRY

           DO K^APSPCCLQ

 +8        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

ZTSKX      KILL APSRX,APSRM,APSRV,AUPNVSIT

 +1        QUIT