PSOP288F ;FIX ERRONEOUS NON-VA MEDS RECORDS IN PHARMACY PATIENT FILE (#55)
;;7.0;OUTPATIENT PHARMACY;**288**;DEC 2007;Build 17
;
CLEAN ;ALLOW USER TO CLEAN UP ERRONEOUS ENTRIES
N PSOI,PSOPAT,PSONVA,PSONVA0,D,PSONOPAT,PSOPATN,PSOERR,PSOIENS,X,X1,X2,Y,PSODIV
F PSOI=1:1 D Q:PSONOPAT=2
.D GETPAT
.I PSONOPAT Q
.D FIX
Q
;
GETPAT ;PROMPT FOR PATIENT
S PSONOPAT=1
W !!
K DIC
S DIC="^PS(55,",DIC(0)="ABEQTVZ",D="B" D IX^DIC
S PSOPAT=+$G(Y(0)),PSOPATN=$G(Y(0,0))
I 'PSOPAT S PSONOPAT=2 Q
S PSODIV=0 F S PSODIV=$O(^XTMP("PSOP288",PSODIV)) Q:PSODIV="" D Q:'PSONOPAT
.I PSOPAT,$D(^XTMP("PSOP288",PSODIV,PSOPAT)) S PSONOPAT=0
.I PSONOPAT W !,"??" S PSONOPAT=1 Q
Q
;
FIX ;FIX THE NON-VA MEDS ENTRY
S PSONVA=0 F S PSONVA=$O(^XTMP("PSOP288",PSODIV,PSOPAT,PSONVA)) Q:'PSONVA D
.W !!,"PATIENT: ",PSOPATN
.S PSONVA0=$G(^PS(55,PSOPAT,"NVA",PSONVA,0))
.S DIE="^PS(55,"_PSOPAT_",""NVA"","
.S DA=PSONVA,DA(1)=PSOPAT
.S DR=".01;1;2;3;4;5;6;7;8;11;12;13"
.D ^DIE K DIE,DA,DR
.W !!
.S PSOIENS=PSONVA_","_PSOPAT_","
.S DIR("A")="Would you like to edit the comments " S DIR(0)="Y" D ^DIR
.I 'Y Q
.S DIC="^PS(55,"_PSOPAT_",""NVA"","_PSONVA_",1"
.S DWPK=1
.D EN^DIWE
.K DIC,DWPK,DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOP288F 1238 printed Dec 13, 2024@02:32:34 Page 2
PSOP288F ;FIX ERRONEOUS NON-VA MEDS RECORDS IN PHARMACY PATIENT FILE (#55)
+1 ;;7.0;OUTPATIENT PHARMACY;**288**;DEC 2007;Build 17
+2 ;
CLEAN ;ALLOW USER TO CLEAN UP ERRONEOUS ENTRIES
+1 NEW PSOI,PSOPAT,PSONVA,PSONVA0,D,PSONOPAT,PSOPATN,PSOERR,PSOIENS,X,X1,X2,Y,PSODIV
+2 FOR PSOI=1:1
Begin DoDot:1
+3 DO GETPAT
+4 IF PSONOPAT
QUIT
+5 DO FIX
End DoDot:1
if PSONOPAT=2
QUIT
+6 QUIT
+7 ;
GETPAT ;PROMPT FOR PATIENT
+1 SET PSONOPAT=1
+2 WRITE !!
+3 KILL DIC
+4 SET DIC="^PS(55,"
SET DIC(0)="ABEQTVZ"
SET D="B"
DO IX^DIC
+5 SET PSOPAT=+$GET(Y(0))
SET PSOPATN=$GET(Y(0,0))
+6 IF 'PSOPAT
SET PSONOPAT=2
QUIT
+7 SET PSODIV=0
FOR
SET PSODIV=$ORDER(^XTMP("PSOP288",PSODIV))
if PSODIV=""
QUIT
Begin DoDot:1
+8 IF PSOPAT
IF $DATA(^XTMP("PSOP288",PSODIV,PSOPAT))
SET PSONOPAT=0
+9 IF PSONOPAT
WRITE !,"??"
SET PSONOPAT=1
QUIT
End DoDot:1
if 'PSONOPAT
QUIT
+10 QUIT
+11 ;
FIX ;FIX THE NON-VA MEDS ENTRY
+1 SET PSONVA=0
FOR
SET PSONVA=$ORDER(^XTMP("PSOP288",PSODIV,PSOPAT,PSONVA))
if 'PSONVA
QUIT
Begin DoDot:1
+2 WRITE !!,"PATIENT: ",PSOPATN
+3 SET PSONVA0=$GET(^PS(55,PSOPAT,"NVA",PSONVA,0))
+4 SET DIE="^PS(55,"_PSOPAT_",""NVA"","
+5 SET DA=PSONVA
SET DA(1)=PSOPAT
+6 SET DR=".01;1;2;3;4;5;6;7;8;11;12;13"
+7 DO ^DIE
KILL DIE,DA,DR
+8 WRITE !!
+9 SET PSOIENS=PSONVA_","_PSOPAT_","
+10 SET DIR("A")="Would you like to edit the comments "
SET DIR(0)="Y"
DO ^DIR
+11 IF 'Y
QUIT
+12 SET DIC="^PS(55,"_PSOPAT_",""NVA"","_PSONVA_",1"
+13 SET DWPK=1
+14 DO EN^DIWE
+15 KILL DIC,DWPK,DIR
End DoDot:1
+16 QUIT
