APSPOST5.m

APSPOST5 ; IHS/DSD/ENM - OUTPAT/DRUG FILE 50 DIVISION FLAG/APU ;  [ 09/03/97   1:30 PM ]

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

EP ;Division Update

 D EP0,EP1,XIT

 Q

EP0 S APSP1=0

 S APSPSITE=$O(^PS(59,0)) Q:APSPSITE=""

 I $P($G(^PS(59.7,1,9999999)),"^",7)]"" Q

 I +$P($G(^PS(59.7,1,9999999)),"^",8) S APSP1=$P(^(9999999),"^",8)-1

 F  S APSP1=$O(^PSDRUG(APSP1)) Q:'APSP1  D SET S $P(^PS(59.7,1,9999999),"^",8)=APSP1

 S APSPM1=" ",APSPM2="The Outpatient Pharmacy Drug File Division Flag update ",APSPM3="has finished on "

 D MSG^APSPOST2,NOW^%DTC S $P(^PS(59.7,1,9999999),"^",7)=$E(%,1,12)

 K APSP1,APSPM1,APSPM2,APSPM3,APSP3,DIE,DA,DR

 Q

SET S DIE="^PSDRUG(",DA=APSP1,DR="9999999.03////^S X=APSPSITE" D ^DIE

 Q

EP1 ;APPLICATION PACKAGE'S USE UPDATE

 S APSP11=0

 I $P($G(^PS(59.7,1,9999999)),"^",9)]"" Q

 I +$P($G(^PS(59.7,1,9999999)),"^",10) S APSP11=$P(^(9999999),"^",10)-1

 F  S APSP11=$O(^PSDRUG(APSP11)) Q:'APSP11  D PAC S $P(^PS(59.7,1,9999999),"^",10)=APSP11

 S APSPM1=" ",APSPM2="The Outpatient Pharmacy Drug File 'Application Package Use' update ",APSPM3="has finished on "

 D MSG^APSPOST2,NOW^%DTC S $P(^PS(59.7,1,9999999),"^",9)=$E(%,1,12)

 Q

PAC S $P(^PSDRUG(APSP11,2),"^",3)="O",^PSDRUG("AIUO",$P(^PSDRUG(APSP11,0),"^"),APSP11)=""

 Q

ZAP ;

 ;F I=0:0 S I=$O(^PSDRUG(I)) Q:'I  S ADIV=$P($G(^PSDRUG(I,9999999)),"^",3) D DEL

 ;Q

DEL ;I ADIV=2 S DA=I,DIK="^PSDRUG(" D ^DIK W "."

 ;Q

XIT K APSP11,APSPSITE

 Q

APSPOST5  ; IHS/DSD/ENM - OUTPAT/DRUG FILE 50 DIVISION FLAG/APU ;  [ 09/03/97   1:30 PM ]

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

EP        ;Division Update

 +1        DO EP0

           DO EP1

           DO XIT

 +2        QUIT 

EP0        SET APSP1=0

 +1        SET APSPSITE=$ORDER(^PS(59,0))

           IF APSPSITE=""

               QUIT 

 +2        IF $PIECE($GET(^PS(59.7,1,9999999)),"^",7)]""

               QUIT 

 +3        IF +$PIECE($GET(^PS(59.7,1,9999999)),"^",8)

               SET APSP1=$PIECE(^(9999999),"^",8)-1

 +4        FOR 

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

               IF 'APSP1

                   QUIT 

               DO SET

               SET $PIECE(^PS(59.7,1,9999999),"^",8)=APSP1

 +5        SET APSPM1=" "

           SET APSPM2="The Outpatient Pharmacy Drug File Division Flag update "

           SET APSPM3="has finished on "

 +6        DO MSG^APSPOST2

           DO NOW^%DTC

           SET $PIECE(^PS(59.7,1,9999999),"^",7)=$EXTRACT(%,1,12)

 +7        KILL APSP1,APSPM1,APSPM2,APSPM3,APSP3,DIE,DA,DR

 +8        QUIT 

SET        SET DIE="^PSDRUG("

           SET DA=APSP1

           SET DR="9999999.03////^S X=APSPSITE"

           DO ^DIE

 +1        QUIT 

EP1       ;APPLICATION PACKAGE'S USE UPDATE

 +1        SET APSP11=0

 +2        IF $PIECE($GET(^PS(59.7,1,9999999)),"^",9)]""

               QUIT 

 +3        IF +$PIECE($GET(^PS(59.7,1,9999999)),"^",10)

               SET APSP11=$PIECE(^(9999999),"^",10)-1

 +4        FOR 

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

               IF 'APSP11

                   QUIT 

               DO PAC

               SET $PIECE(^PS(59.7,1,9999999),"^",10)=APSP11

 +5        SET APSPM1=" "

           SET APSPM2="The Outpatient Pharmacy Drug File 'Application Package Use' update "

           SET APSPM3="has finished on "

 +6        DO MSG^APSPOST2

           DO NOW^%DTC

           SET $PIECE(^PS(59.7,1,9999999),"^",9)=$EXTRACT(%,1,12)

 +7        QUIT 

PAC        SET $PIECE(^PSDRUG(APSP11,2),"^",3)="O"

           SET ^PSDRUG("AIUO",$PIECE(^PSDRUG(APSP11,0),"^"),APSP11)=""

 +1        QUIT 

ZAP       ;

 +1       ;F I=0:0 S I=$O(^PSDRUG(I)) Q:'I  S ADIV=$P($G(^PSDRUG(I,9999999)),"^",3) D DEL

 +2       ;Q

DEL       ;I ADIV=2 S DA=I,DIK="^PSDRUG(" D ^DIK W "."

 +1       ;Q

XIT        KILL APSP11,APSPSITE

 +1        QUIT