PSOATRF1.m

PSOATRF1 ;BIR/MHA - Automate Internet Refill Cont ;07/24/07

 ;;7.0;OUTPATIENT PHARMACY;**264**;DEC 1997;Build 19

 ;Reference ^PSDRUG supported by DBIA 221

 ;

SMAIL ;

 S ZZ="PSOATRF"

 S DV="" F  S DV=$O(^XTMP(ZZ,$J,DV)) Q:DV=""  S DIVN=$P(^PS(59,DV,0),U) D BMAIL

 K ^TMP(ZZ,$J)

 Q

 ;

BMAIL ;

 K ^TMP(ZZ,$J)

 S XMSUB=DIVN_" Internet Refills Not Processed List, ",XMDUZ=.5,XMDUN="Pharmacy Manager"

 S LC=1,^TMP(ZZ,$J,LC)="Internet Refills Not Processed Report for the "_DIVN_" Division.",LC=LC+1

 S ^TMP(ZZ,$J,LC)="",LC=LC+1

 S ^TMP(ZZ,$J,LC)="The following refill requests were not processed:  ",LC=LC+1

 S ^TMP(ZZ,$J,LC)="",LC=LC+1

 S DFN="" F  S DFN=$O(^XTMP(ZZ,$J,DV,DFN)) Q:DFN=""  D

 .D PID^VADPT

 .S ^TMP(ZZ,$J,LC)="Patient: "_$P(^DPT(DFN,0),U)_"   SSN: "_$G(VA("BID")),LC=LC+1

 .S ^TMP(ZZ,$J,LC)="",LC=LC+1

 .S RX="" F  S RX=$O(^XTMP(ZZ,$J,DV,DFN,RX)) Q:RX=""  D

 ..I '$D(^PSRX(RX,0)) S ^TMP(ZZ,$J,LC)="There is no data for IEN #: "_RX,LC=LC+1 Q

 ..S RX0=^PSRX(RX,0)

 ..S ^TMP(ZZ,$J,LC)="  Rx #: "_$P(RX0,U)_"  (REF #"_(1+$$LSTRFL^PSOBPSU1(RX))_")  Qty: "_$P(RX0,U,7),LC=LC+1

 ..S ^TMP(ZZ,$J,LC)="  Drug: "_$S($P(^PSDRUG($P(RX0,U,6),0),U)]"":$P(^PSDRUG($P(RX0,U,6),0),U),1:"UNKNOWN"),LC=LC+1

 ..S ^TMP(ZZ,$J,LC)="  Reason: "_^XTMP(ZZ,$J,DV,DFN,RX),LC=LC+1

 ..S ^TMP(ZZ,$J,LC)="  ",LC=LC+1 S ^TMP(ZZ,$J,LC)="  ",LC=LC+1

 D GRP^PSOATRF

 S:'$O(XMY(0)) XMY(DUZ)=""

 S XMTEXT="^TMP(""PSOATRF"",$J," N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB

 Q

 ;

PSOATRF1  ;BIR/MHA - Automate Internet Refill Cont ;07/24/07

 +1       ;;7.0;OUTPATIENT PHARMACY;**264**;DEC 1997;Build 19

 +2       ;Reference ^PSDRUG supported by DBIA 221

 +3       ;

SMAIL     ;

 +1        SET ZZ="PSOATRF"

 +2        SET DV=""

           FOR 

               SET DV=$ORDER(^XTMP(ZZ,$JOB,DV))

               IF DV=""

                   QUIT 

               SET DIVN=$PIECE(^PS(59,DV,0),U)

               DO BMAIL

 +3        KILL ^TMP(ZZ,$JOB)

 +4        QUIT 

 +5       ;

BMAIL     ;

 +1        KILL ^TMP(ZZ,$JOB)

 +2        SET XMSUB=DIVN_" Internet Refills Not Processed List, "

           SET XMDUZ=.5

           SET XMDUN="Pharmacy Manager"

 +3        SET LC=1

           SET ^TMP(ZZ,$JOB,LC)="Internet Refills Not Processed Report for the "_DIVN_" Division."

           SET LC=LC+1

 +4        SET ^TMP(ZZ,$JOB,LC)=""

           SET LC=LC+1

 +5        SET ^TMP(ZZ,$JOB,LC)="The following refill requests were not processed:  "

           SET LC=LC+1

 +6        SET ^TMP(ZZ,$JOB,LC)=""

           SET LC=LC+1

 +7        SET DFN=""

           FOR 

               SET DFN=$ORDER(^XTMP(ZZ,$JOB,DV,DFN))

               IF DFN=""

                   QUIT 

               Begin DoDot:1

 +8                DO PID^VADPT

 +9                SET ^TMP(ZZ,$JOB,LC)="Patient: "_$PIECE(^DPT(DFN,0),U)_"   SSN: "_$GET(VA("BID"))

                   SET LC=LC+1

 +10               SET ^TMP(ZZ,$JOB,LC)=""

                   SET LC=LC+1

 +11               SET RX=""

                   FOR 

                       SET RX=$ORDER(^XTMP(ZZ,$JOB,DV,DFN,RX))

                       IF RX=""

                           QUIT 

                       Begin DoDot:2

 +12                       IF '$DATA(^PSRX(RX,0))

                               SET ^TMP(ZZ,$JOB,LC)="There is no data for IEN #: "_RX

                               SET LC=LC+1

                               QUIT 

 +13                       SET RX0=^PSRX(RX,0)

 +14                       SET ^TMP(ZZ,$JOB,LC)="  Rx #: "_$PIECE(RX0,U)_"  (REF #"_(1+$$LSTRFL^PSOBPSU1(RX))_")  Qty: "_$PIECE(RX0,U,7)

                           SET LC=LC+1

 +15                       SET ^TMP(ZZ,$JOB,LC)="  Drug: "_$SELECT($PIECE(^PSDRUG($PIECE(RX0,U,6),0),U)]"":$PIECE(^PSDRUG($PIECE(RX0,U,6),0),U),1:"UNKNOWN")

                           SET LC=LC+1

 +16                       SET ^TMP(ZZ,$JOB,LC)="  Reason: "_^XTMP(ZZ,$JOB,DV,DFN,RX)

                           SET LC=LC+1

 +17                       SET ^TMP(ZZ,$JOB,LC)="  "

                           SET LC=LC+1

                           SET ^TMP(ZZ,$JOB,LC)="  "

                           SET LC=LC+1

                       End DoDot:2

               End DoDot:1

 +18       DO GRP^PSOATRF

 +19       IF '$ORDER(XMY(0))

               SET XMY(DUZ)=""

 +20       SET XMTEXT="^TMP(""PSOATRF"",$J,"

           NEW DIFROM

           DO ^XMD

           KILL XMDUZ,XMTEXT,XMSUB

 +21       QUIT 

 +22      ;