APSPOST4.m

APSPOST4 ; IHS/DSD/ENM - OUTPATIENT/INTERVENTION PROVIDER/DIV ;  [ 09/03/97   1:30 PM ]

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

EP ;

 S APSP1=0

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

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

 F  S APSP1=$O(^APSPQA(32.4,APSP1)) Q:'APSP1  S APSP2=$P($G(^APSPQA(32.4,APSP1,0)),"^",3) I APSP2]"" D SET S $P(^PS(59.7,1,9999999),"^",6)=APSP1

 S APSPM1=" ",APSPM2="The Outpatient Pharmacy Intervention/Provider update ",APSPM3="has finished on "

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

 D ^APSPOSTP ;CONVERT CONTACTED PROVIDER FIELD 08/16/96

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

 Q

SET S APSP3=$G(^DIC(16,APSP2,"A3"))

 I +APSP3,$D(^VA(200,APSP3,0)) D SET1

 Q

SET1 S DIE="^APSPQA(32.4,",DA=APSP1,DR=".03////^S X=APSP3" D ^DIE

 Q

EP1 ; Entry Point for file 9009032.4 field .16(Division) CONVERSION

 S APSPVAR=1,APSP1=0

 F  S APSP1=$O(^APSPQA(32.4,APSP1)) Q:'APSP1  D SET2

 S APSPM1=" ",APSPM2="The Outpatient Pharmacy Intervention/Division update ",APSPM3="has finished on "

 D MSG^APSPOST2

 Q

SET2 S DIE="^APSPQA(32.4,",DA=APSP1,DR=".16////^S X=APSPVAR" D ^DIE

 Q

APSPOST4  ; IHS/DSD/ENM - OUTPATIENT/INTERVENTION PROVIDER/DIV ;  [ 09/03/97   1:30 PM ]

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

EP        ;

 +1        SET APSP1=0

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

               QUIT 

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

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

 +4        FOR 

               SET APSP1=$ORDER(^APSPQA(32.4,APSP1))

               IF 'APSP1

                   QUIT 

               SET APSP2=$PIECE($GET(^APSPQA(32.4,APSP1,0)),"^",3)

               IF APSP2]""

                   DO SET

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

 +5        SET APSPM1=" "

           SET APSPM2="The Outpatient Pharmacy Intervention/Provider update "

           SET APSPM3="has finished on "

 +6        DO MSG^APSPOST2

           DO NOW^%DTC

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

 +7       ;CONVERT CONTACTED PROVIDER FIELD 08/16/96

           DO ^APSPOSTP

 +8        KILL APSP1,APSP2,APSPM1,APSPM2,APSPM3,DIE,DA,DR

 +9        QUIT 

SET        SET APSP3=$GET(^DIC(16,APSP2,"A3"))

 +1        IF +APSP3

               IF $DATA(^VA(200,APSP3,0))

                   DO SET1

 +2        QUIT 

SET1       SET DIE="^APSPQA(32.4,"

           SET DA=APSP1

           SET DR=".03////^S X=APSP3"

           DO ^DIE

 +1        QUIT 

EP1       ; Entry Point for file 9009032.4 field .16(Division) CONVERSION

 +1        SET APSPVAR=1

           SET APSP1=0

 +2        FOR 

               SET APSP1=$ORDER(^APSPQA(32.4,APSP1))

               IF 'APSP1

                   QUIT 

               DO SET2

 +3        SET APSPM1=" "

           SET APSPM2="The Outpatient Pharmacy Intervention/Division update "

           SET APSPM3="has finished on "

 +4        DO MSG^APSPOST2

 +5        QUIT 

SET2       SET DIE="^APSPQA(32.4,"

           SET DA=APSP1

           SET DR=".16////^S X=APSPVAR"

           DO ^DIE

 +1        QUIT