PSOATRF1 ;BIR/MHA - Automate Internet Refill Cont ;Jan 20, 2022@06:59:24
;;7.0;OUTPATIENT PHARMACY;**264,441**;DEC 1997;Build 208
;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/Fills 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/fill 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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOATRF1 1504 printed Dec 13, 2024@02:24:31 Page 2
PSOATRF1 ;BIR/MHA - Automate Internet Refill Cont ;Jan 20, 2022@06:59:24
+1 ;;7.0;OUTPATIENT PHARMACY;**264,441**;DEC 1997;Build 208
+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/Fills 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/fill 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 ;
