APSPOST6.m

APSPOST6 ; IHS/DSD/ENM - OUTPATIENT PHARMACY FILE 50 MAINTENANCE ;  [ 09/03/97   1:30 PM ]

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

 ;This program will stuff the VA Drug Class Code in field 2 of the

 ;zero node if data exist in the 6th piece of the "ND" node

EP ;

 D START

 K APSPE,APSPDC,^TMP("PSOP-CLASS"),DIK,DA

 Q

START S APSPE=0

 I $D(^TMP("PSOP-CLASS")) S APSPE=^TMP("PSOP-CLASS")-1

 ;

 F  S APSPE=$O(^PSDRUG(APSPE)) Q:'APSPE  S APSPDC=$P($G(^PSDRUG(APSPE,"ND")),"^",6) D

 .S ^TMP("PSOP-CLASS")=APSPE

 .I APSPDC="" S $P(^PSDRUG(APSPE,0),"^",2)="" Q

 .S $P(^PSDRUG(APSPE,0),"^",2)=$P($G(^PS(50.605,APSPDC,0)),"^")

 .S DIK="^PSDRUG(",DA=APSPE,DIK(1)="2^AC^APCC" D EN^DIK

 Q

APSPOST6  ; IHS/DSD/ENM - OUTPATIENT PHARMACY FILE 50 MAINTENANCE ;  [ 09/03/97   1:30 PM ]

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

 +2       ;This program will stuff the VA Drug Class Code in field 2 of the

 +3       ;zero node if data exist in the 6th piece of the "ND" node

EP        ;

 +1        DO START

 +2        KILL APSPE,APSPDC,^TMP("PSOP-CLASS"),DIK,DA

 +3        QUIT 

START      SET APSPE=0

 +1        IF $DATA(^TMP("PSOP-CLASS"))

               SET APSPE=^TMP("PSOP-CLASS")-1

 +2       ;

 +3        FOR 

               SET APSPE=$ORDER(^PSDRUG(APSPE))

               IF 'APSPE

                   QUIT 

               SET APSPDC=$PIECE($GET(^PSDRUG(APSPE,"ND")),"^",6)

               Begin DoDot:1

 +4                SET ^TMP("PSOP-CLASS")=APSPE

 +5                IF APSPDC=""

                       SET $PIECE(^PSDRUG(APSPE,0),"^",2)=""

                       QUIT 

 +6                SET $PIECE(^PSDRUG(APSPE,0),"^",2)=$PIECE($GET(^PS(50.605,APSPDC,0)),"^")

 +7                SET DIK="^PSDRUG("

                   SET DA=APSPE

                   SET DIK(1)="2^AC^APCC"

                   DO EN^DIK

               End DoDot:1

 +8        QUIT