APSPRV.m

APSPRV ; IHS/DSD/ENM - BACKFILL PROVIDERS TO V MEDICATION FILE ;  [ 09/03/97   1:30 PM ]

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

 ; This utility routine will fill the provider field of the V MEDICATION

 ; file with the provider from the PRESCRIPTION file for that

 ; prescription entry.

 ; It took 3 minutes to do 7600 entries in the V MEDICATION file on

 ; an Altos system using MSM.

 ;

 S %DT("A")="PLEASE ENTER BEGINNING DATE: "

 S %DT="AE"

 D ^%DT

 I Y=-1 G EXIT

 S APSPBD=Y

APSPDATE ;

 F APSPDATE=(APSPBD-1):0 S APSPDATE=$O(^PSRX("AD",APSPDATE)) Q:APSPDATE'=+APSPDATE  D

 . S APSPRXDA=0

 . F  S APSPRXDA=$O(^PSRX("AD",APSPDATE,APSPRXDA)) Q:APSPRXDA'=+APSPRXDA  S APSPCNT=$O(^(APSPRXDA,"")) D

 .. S:$D(^PSRX(APSPRXDA,0)) APSPRX0=^(0)

 .. Q:'$D(APSPRX0)

 .. S:$P(APSPRX0,U,4)]"" APSPRV=$P(APSPRX0,U,4)

 .. I '$D(APSPRV) K APSPRX0,APSPCNT Q

 .. I APSPCNT=0,$D(^PSRX(APSPRXDA,999999911))#2,^(999999911)]"" S APSPLINK=^(999999911)

 .. I APSPCNT'=0,$D(^PSRX(APSPRXDA,1,APSPCNT,999999911))#2,^(999999911)]"" S APSPLINK=^(999999911)

 .. I '$D(APSPLINK) K APSPRX0,APSPRV,APSPCNT Q

 .. I $D(^AUPNVMED(APSPLINK,0))#2 S $P(^(0),U,9)=APSPRV W "."

 .. K APSPRV,APSPCNT,APSPLINK,APSPRX0

EXIT ;

 K APSPCNT,APSPRX0,APSPLINK,APSPBD,APSPDATE,%DT,APSPRXDA,Y

 Q

APSPRV    ; IHS/DSD/ENM - BACKFILL PROVIDERS TO V MEDICATION FILE ;  [ 09/03/97   1:30 PM ]

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

 +2       ; This utility routine will fill the provider field of the V MEDICATION

 +3       ; file with the provider from the PRESCRIPTION file for that

 +4       ; prescription entry.

 +5       ; It took 3 minutes to do 7600 entries in the V MEDICATION file on

 +6       ; an Altos system using MSM.

 +7       ;

 +8        SET %DT("A")="PLEASE ENTER BEGINNING DATE: "

 +9        SET %DT="AE"

 +10       DO ^%DT

 +11       IF Y=-1

               GOTO EXIT

 +12       SET APSPBD=Y

APSPDATE  ;

 +1        FOR APSPDATE=(APSPBD-1):0

               SET APSPDATE=$ORDER(^PSRX("AD",APSPDATE))

               IF APSPDATE'=+APSPDATE

                   QUIT 

               Begin DoDot:1

 +2                SET APSPRXDA=0

 +3                FOR 

                       SET APSPRXDA=$ORDER(^PSRX("AD",APSPDATE,APSPRXDA))

                       IF APSPRXDA'=+APSPRXDA

                           QUIT 

                       SET APSPCNT=$ORDER(^(APSPRXDA,""))

                       Begin DoDot:2

 +4                        IF $DATA(^PSRX(APSPRXDA,0))

                               SET APSPRX0=^(0)

 +5                        IF '$DATA(APSPRX0)

                               QUIT 

 +6                        IF $PIECE(APSPRX0,U,4)]""

                               SET APSPRV=$PIECE(APSPRX0,U,4)

 +7                        IF '$DATA(APSPRV)

                               KILL APSPRX0,APSPCNT

                               QUIT 

 +8                        IF APSPCNT=0

                               IF $DATA(^PSRX(APSPRXDA,999999911))#2

                                   IF ^(999999911)]""

                                       SET APSPLINK=^(999999911)

 +9                        IF APSPCNT'=0

                               IF $DATA(^PSRX(APSPRXDA,1,APSPCNT,999999911))#2

                                   IF ^(999999911)]""

                                       SET APSPLINK=^(999999911)

 +10                       IF '$DATA(APSPLINK)

                               KILL APSPRX0,APSPRV,APSPCNT

                               QUIT 

 +11                       IF $DATA(^AUPNVMED(APSPLINK,0))#2

                               SET $PIECE(^(0),U,9)=APSPRV

                               WRITE "."

 +12                       KILL APSPRV,APSPCNT,APSPLINK,APSPRX0

                       End DoDot:2

               End DoDot:1

EXIT      ;

 +1        KILL APSPCNT,APSPRX0,APSPLINK,APSPBD,APSPDATE,%DT,APSPRXDA,Y

 +2        QUIT