PSOP288R ;REPORT FOR PATCH PSO*7.0*288
;;7.0;OUTPATIENT PHARMACY;**288**;DEC 2007;Build 17
;External reference to File ^PS(55 supported by DBIA 2228
;External reference to File ^DPT supported by DBIA 10035
;External reference to File ^SC supported by DBIA 10040
;
;FIND ERRONEOUS RECORDS IN THE PHARMACY PATIENT FILE (#55) AND ALLOW THE USER TO CLEAN THEM UP
;
EN W !!,"CREATING REPORT...",!
S ZTRTN="QUEUE^PSOP288R",ZTDESC="Erroneous Non-VA Meds Records Report",ZTIO="" D ^%ZTLOAD K IO("Q")
Q
QUEUE N PSOPAT,PSONVA,PSONVA0,PSODRG,PSOI,PSOSPC,PSOPATDB,PSOTXT,PSOTEXT,XMY,XMTEXT,XMSUB,XMDUZ,PSOPATI,X,X1,X2,PSOLOC,PSODIV,PSODIVN
S PSOSPC="",PSODIVN=""
F PSOI=1:1:20 S $E(PSOSPC,PSOI)=" "
K ^XTMP("PSOP288") S X1=DT,X2=+90 D C^%DTC S ^XTMP("PSOP288",0)=$G(X)_U_DT_"^Erroneous Pharmacy Pateint File (#55) Non-VA Meds records"
S PSOPAT=0 F S PSOPAT=$O(^PS(55,PSOPAT)) Q:'PSOPAT D
.S PSONVA=0 F S PSONVA=$O(^PS(55,PSOPAT,"NVA",PSONVA)) Q:'PSONVA D
..S PSONVA0=$G(^PS(55,PSOPAT,"NVA",PSONVA,0))
..I $P(PSONVA0,"^",10)]"",$P(PSONVA0,"^",11)]"" Q
..S PSOLOC=$P(PSONVA0,"^",12) I PSOLOC S PSODIV=$P(^SC(PSOLOC,0),"^",15) I PSODIV]"" S PSODIVN=$P($G(^DG(40.8,PSODIV,0)),"^")
..S:PSODIVN="" PSODIVN="UNKNOWN"
..S PSODRG=+PSONVA0
..S ^XTMP("PSOP288",PSODIVN,PSOPAT,PSONVA)=PSODRG_U_$P($G(^PS(50.7,PSODRG,0)),"^")
REP ;CREATE REPORT - SEND TO USER
S XMY(DUZ)=""
S XMDUZ=.5,XMSUB="ERRONEOUS NON-VA MEDS RECORDS IN PHARMACY PATIENT FILE"
;
S PSOTXT=1
S PSOTEXT(PSOTXT)="REPORT OF ERRONEOUS PHARMACY PATIENT FILE (#55) NON-VA MEDS RECORDS"
S PSODIVN=0 F S PSODIVN=$O(^XTMP("PSOP288",PSODIVN)) Q:PSODIVN="" D
.S PSOTXT=PSOTXT+1
.S PSOTEXT(PSOTXT)=""
.S PSOTEXT(PSOTXT+1)="DIVISION: "_PSODIVN
.S PSOTEXT(PSOTXT+2)=""
.S PSOTXT=PSOTXT+2
.S PSOTEXT(PSOTXT)="IEN - PATIENT NAME",PSOTXT=PSOTXT+1
.S PSOTEXT(PSOTXT)=$E(PSOSPC,1,3)_"DRUG IEN - DRUG NAME",PSOTXT=PSOTXT+1
.S PSOTEXT(PSOTXT)="",PSOTXT=PSOTXT+1
.S PSOPAT=0 F S PSOPAT=$O(^XTMP("PSOP288",PSODIVN,PSOPAT)) Q:'PSOPAT D
..S PSOPATI=$G(^DPT(PSOPAT,0))
..S PSOTEXT(PSOTXT)=PSOPAT_" - "_$P(PSOPATI,U)
..S PSOTXT=PSOTXT+1
..S PSONVA=0 F S PSONVA=$O(^XTMP("PSOP288",PSODIVN,PSOPAT,PSONVA)) Q:'PSONVA D
...S PSONVA0=$G(^PS(55,PSOPAT,"NVA",PSONVA,0))
...S PSODRG=+PSONVA0
...S PSOTEXT(PSOTXT)=$E(PSOSPC,1,3)_$P(PSONVA0,U)_" - "_$P($G(^PS(50.7,PSODRG,0)),U)
...S PSOTXT=PSOTXT+1
I PSOTXT=1 S PSOTEXT(PSOTXT+1)="",PSOTEXT(PSOTXT+2)="NO ERRONEOUS ENTRIES FOUND"
S XMTEXT="PSOTEXT(" N DIFROM D ^XMD K XMDUZ,XMTEXT,XMSUB
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOP288R 2553 printed Sep 23, 2025@20:09 Page 2
PSOP288R ;REPORT FOR PATCH PSO*7.0*288
+1 ;;7.0;OUTPATIENT PHARMACY;**288**;DEC 2007;Build 17
+2 ;External reference to File ^PS(55 supported by DBIA 2228
+3 ;External reference to File ^DPT supported by DBIA 10035
+4 ;External reference to File ^SC supported by DBIA 10040
+5 ;
+6 ;FIND ERRONEOUS RECORDS IN THE PHARMACY PATIENT FILE (#55) AND ALLOW THE USER TO CLEAN THEM UP
+7 ;
EN WRITE !!,"CREATING REPORT...",!
+1 SET ZTRTN="QUEUE^PSOP288R"
SET ZTDESC="Erroneous Non-VA Meds Records Report"
SET ZTIO=""
DO ^%ZTLOAD
KILL IO("Q")
+2 QUIT
QUEUE NEW PSOPAT,PSONVA,PSONVA0,PSODRG,PSOI,PSOSPC,PSOPATDB,PSOTXT,PSOTEXT,XMY,XMTEXT,XMSUB,XMDUZ,PSOPATI,X,X1,X2,PSOLOC,PSODIV,PSODIVN
+1 SET PSOSPC=""
SET PSODIVN=""
+2 FOR PSOI=1:1:20
SET $EXTRACT(PSOSPC,PSOI)=" "
+3 KILL ^XTMP("PSOP288")
SET X1=DT
SET X2=+90
DO C^%DTC
SET ^XTMP("PSOP288",0)=$GET(X)_U_DT_"^Erroneous Pharmacy Pateint File (#55) Non-VA Meds records"
+4 SET PSOPAT=0
FOR
SET PSOPAT=$ORDER(^PS(55,PSOPAT))
if 'PSOPAT
QUIT
Begin DoDot:1
+5 SET PSONVA=0
FOR
SET PSONVA=$ORDER(^PS(55,PSOPAT,"NVA",PSONVA))
if 'PSONVA
QUIT
Begin DoDot:2
+6 SET PSONVA0=$GET(^PS(55,PSOPAT,"NVA",PSONVA,0))
+7 IF $PIECE(PSONVA0,"^",10)]""
IF $PIECE(PSONVA0,"^",11)]""
QUIT
+8 SET PSOLOC=$PIECE(PSONVA0,"^",12)
IF PSOLOC
SET PSODIV=$PIECE(^SC(PSOLOC,0),"^",15)
IF PSODIV]""
SET PSODIVN=$PIECE($GET(^DG(40.8,PSODIV,0)),"^")
+9 if PSODIVN=""
SET PSODIVN="UNKNOWN"
+10 SET PSODRG=+PSONVA0
+11 SET ^XTMP("PSOP288",PSODIVN,PSOPAT,PSONVA)=PSODRG_U_$PIECE($GET(^PS(50.7,PSODRG,0)),"^")
End DoDot:2
End DoDot:1
REP ;CREATE REPORT - SEND TO USER
+1 SET XMY(DUZ)=""
+2 SET XMDUZ=.5
SET XMSUB="ERRONEOUS NON-VA MEDS RECORDS IN PHARMACY PATIENT FILE"
+3 ;
+4 SET PSOTXT=1
+5 SET PSOTEXT(PSOTXT)="REPORT OF ERRONEOUS PHARMACY PATIENT FILE (#55) NON-VA MEDS RECORDS"
+6 SET PSODIVN=0
FOR
SET PSODIVN=$ORDER(^XTMP("PSOP288",PSODIVN))
if PSODIVN=""
QUIT
Begin DoDot:1
+7 SET PSOTXT=PSOTXT+1
+8 SET PSOTEXT(PSOTXT)=""
+9 SET PSOTEXT(PSOTXT+1)="DIVISION: "_PSODIVN
+10 SET PSOTEXT(PSOTXT+2)=""
+11 SET PSOTXT=PSOTXT+2
+12 SET PSOTEXT(PSOTXT)="IEN - PATIENT NAME"
SET PSOTXT=PSOTXT+1
+13 SET PSOTEXT(PSOTXT)=$EXTRACT(PSOSPC,1,3)_"DRUG IEN - DRUG NAME"
SET PSOTXT=PSOTXT+1
+14 SET PSOTEXT(PSOTXT)=""
SET PSOTXT=PSOTXT+1
+15 SET PSOPAT=0
FOR
SET PSOPAT=$ORDER(^XTMP("PSOP288",PSODIVN,PSOPAT))
if 'PSOPAT
QUIT
Begin DoDot:2
+16 SET PSOPATI=$GET(^DPT(PSOPAT,0))
+17 SET PSOTEXT(PSOTXT)=PSOPAT_" - "_$PIECE(PSOPATI,U)
+18 SET PSOTXT=PSOTXT+1
+19 SET PSONVA=0
FOR
SET PSONVA=$ORDER(^XTMP("PSOP288",PSODIVN,PSOPAT,PSONVA))
if 'PSONVA
QUIT
Begin DoDot:3
+20 SET PSONVA0=$GET(^PS(55,PSOPAT,"NVA",PSONVA,0))
+21 SET PSODRG=+PSONVA0
+22 SET PSOTEXT(PSOTXT)=$EXTRACT(PSOSPC,1,3)_$PIECE(PSONVA0,U)_" - "_$PIECE($GET(^PS(50.7,PSODRG,0)),U)
+23 SET PSOTXT=PSOTXT+1
End DoDot:3
End DoDot:2
End DoDot:1
+24 IF PSOTXT=1
SET PSOTEXT(PSOTXT+1)=""
SET PSOTEXT(PSOTXT+2)="NO ERRONEOUS ENTRIES FOUND"
+25 SET XMTEXT="PSOTEXT("
NEW DIFROM
DO ^XMD
KILL XMDUZ,XMTEXT,XMSUB
+26 QUIT
