PSOP288F.m

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

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