| 1 | PSOP288F        ;FIX ERRONEOUS NON-VA MEDS RECORDS IN PHARMACY PATIENT FILE (#55)
 | 
|---|
| 2 |         ;;7.0;OUTPATIENT PHARMACY;**288**;DEC 2007;Build 17
 | 
|---|
| 3 |         ;
 | 
|---|
| 4 | CLEAN   ;ALLOW USER TO CLEAN UP ERRONEOUS ENTRIES
 | 
|---|
| 5 |         N PSOI,PSOPAT,PSONVA,PSONVA0,D,PSONOPAT,PSOPATN,PSOERR,PSOIENS,X,X1,X2,Y,PSODIV
 | 
|---|
| 6 |         F PSOI=1:1 D  Q:PSONOPAT=2
 | 
|---|
| 7 |         .D GETPAT
 | 
|---|
| 8 |         .I PSONOPAT Q
 | 
|---|
| 9 |         .D FIX
 | 
|---|
| 10 |         Q
 | 
|---|
| 11 |         ;
 | 
|---|
| 12 | GETPAT  ;PROMPT FOR PATIENT
 | 
|---|
| 13 |         S PSONOPAT=1
 | 
|---|
| 14 |         W !!
 | 
|---|
| 15 |         K DIC
 | 
|---|
| 16 |         S DIC="^PS(55,",DIC(0)="ABEQTVZ",D="B" D IX^DIC
 | 
|---|
| 17 |         S PSOPAT=+$G(Y(0)),PSOPATN=$G(Y(0,0))
 | 
|---|
| 18 |         I 'PSOPAT S PSONOPAT=2 Q
 | 
|---|
| 19 |         S PSODIV=0 F  S PSODIV=$O(^XTMP("PSOP288",PSODIV)) Q:PSODIV=""  D  Q:'PSONOPAT
 | 
|---|
| 20 |         .I PSOPAT,$D(^XTMP("PSOP288",PSODIV,PSOPAT)) S PSONOPAT=0
 | 
|---|
| 21 |         .I PSONOPAT W !,"??" S PSONOPAT=1 Q
 | 
|---|
| 22 |         Q
 | 
|---|
| 23 |         ;
 | 
|---|
| 24 | FIX     ;FIX THE NON-VA MEDS ENTRY
 | 
|---|
| 25 |         S PSONVA=0 F  S PSONVA=$O(^XTMP("PSOP288",PSODIV,PSOPAT,PSONVA)) Q:'PSONVA  D
 | 
|---|
| 26 |         .W !!,"PATIENT: ",PSOPATN
 | 
|---|
| 27 |         .S PSONVA0=$G(^PS(55,PSOPAT,"NVA",PSONVA,0))
 | 
|---|
| 28 |         .S DIE="^PS(55,"_PSOPAT_",""NVA"","
 | 
|---|
| 29 |         .S DA=PSONVA,DA(1)=PSOPAT
 | 
|---|
| 30 |         .S DR=".01;1;2;3;4;5;6;7;8;11;12;13"
 | 
|---|
| 31 |         .D ^DIE K DIE,DA,DR
 | 
|---|
| 32 |         .W !!
 | 
|---|
| 33 |         .S PSOIENS=PSONVA_","_PSOPAT_","
 | 
|---|
| 34 |         .S DIR("A")="Would you like to edit the comments " S DIR(0)="Y" D ^DIR
 | 
|---|
| 35 |         .I 'Y Q
 | 
|---|
| 36 |         .S DIC="^PS(55,"_PSOPAT_",""NVA"","_PSONVA_",1"
 | 
|---|
| 37 |         .S DWPK=1
 | 
|---|
| 38 |         .D EN^DIWE
 | 
|---|
| 39 |         .K DIC,DWPK,DIR
 | 
|---|
| 40 |         Q
 | 
|---|