- 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 Feb 18, 2025@23:59 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