PSOCIDC9 ;BIR/LE - continuation of activity log corrections ;2/28/05 12:50pm
 ;;7.0;OUTPATIENT PHARMACY;**239,250**;DEC 1997
 ;
RPT ;
 N JOBN,NAMSP,ZTDESC,ZTRTN,ZTQUEUED,ZTREQ
 S NAMSP=$$NAMSP^PSOCIDC7
 S JOBN="CIDC ACTIVITY LOG CORRECTION"
 L +^XTMP(NAMSP):0 I '$T D  Q
 .W !,JOBN_" job for PSO*7*239 is still running.  Halting..."
 L -^XTMP(NAMSP)
 W !!,"This report reflects all prescriptions where the activity and"
 W !,"copay activity logs were corrected.  For detailed information,"
 W !,"please view the activity and copay logs on the prescriptions."
 ;
 W !!,"You may queue the report to print, if you wish.",!
 ;
DVC ;
 K %ZIS,POP,IOP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! G DONE
QUEUE ;
 I $D(IO("Q")) S ZTRTN="START^PSOCIDC9",ZTDESC=JOBN_" CIDC Activity Logs Corrections" D ^%ZTLOAD K %ZSI W !,"Report queued to print.",! G DONE
START ;
 U IO
 N BLDT,RXO,NAMSP,PSOFILL,PSODFN,PSONAM,PSOOUT,PSODV,RXP,SSN,PSODIV,PSODV
 N CANCEL,JOBN,PSOPATID,PSOTOT
 S NAMSP=$$NAMSP^PSOCIDC7
 ;****************************************************** for testing only - next line
 S JOBN="CIDC ACTIVITY LOGS CORRECTION"
 S PSOOUT=0,PSODV=$S($E(IOST)="C":"C",1:"P")
 S PSOPGCT=0,PSOPGLN=IOSL-7,PSOPGCT=1
 S BLDT=$P($G(^XTMP(NAMSP,0,"LAST")),"^",2)
 I '$D(DT) S DT=$$NOW^XLFDT
 D TITLE
 S (PSOTOT,PSONAM)=""
 F  S PSONAM=$O(^XTMP(NAMSP,"LOG",PSONAM)) Q:PSONAM=""  D
 .S PSODFN=""
 .F  S PSODFN=$O(^XTMP(NAMSP,"LOG",PSONAM,PSODFN)) Q:PSODFN=""  D
 ..S RXP=""
 ..F  S RXP=$O(^XTMP(NAMSP,"LOG",PSONAM,PSODFN,RXP)) Q:RXP=""  D
 ...D FULL Q:$G(PSOOUT)  S PSONAME=$P($G(^DPT(PSODFN,0)),"^"),PSOTOT=PSOTOT+1
 ...W !,$E(PSONAME,1,14)
 ...D PRTSSN
 ...S RXO=$P($G(^PSRX(RXP,0)),"^")
 ...W ?41," ",RXO  ;," (",PSOFILL,")"
 W:PSOTOT'="" !,"Total number of prescriptions modified: ",PSOTOT
 G END
 ;
FULL ;
 I ($Y+7)>IOSL&('$G(PSOOUT)) D TITLE
 Q
 ;
TITLE ;
 I $G(PSODV)="C",$G(PSOPGCT)'=1 W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSOOUT=1 Q
 ;
 W @IOF D
 . W !,"Patch PSO*7*239 - Corrected Activity and Copay Activity logs",!!
 . W "Note that this report reflects all prescriptions where the activity and/or",!
 . W "copay activity logs were corrected. For detailed information, please view",!
 . W "the activity and copay activity log on the prescription.",!
 ;
 S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?70,"Page: ",PSOPGCT,!
 F MJT=1:1:79 W "="
 ;W !?55,"Updated",?67,"Updated"
 ;W !,?55,"Activity",?67,"COPAY"
 W !,"PATIENT NAME     (SSN)       DIV",?42,"RX# " ;,?55,"Log",?67,"Activity Log"   ;,?55,"RELEASE DATE",?69,"REL   BILL"
 W !,"---------------  -------  --------------",?42,"------------"
 ;W ?55,"------------",?67,"-----------"
 S PSOPGCT=PSOPGCT+1
 Q
 ;
END ;
 I '$G(PSOOUT),$G(PSODV)="C" W !!,"** End of Report **" K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
 I $G(PSODV)="C" W !
 E  W @IOF
DONE ;
 K MJT,PSOPGCT,PSOPGLN,Y,DIR,X,IOP,POP,IO("Q"),DIRUT,DUOUT,DTOUT
 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
 Q
 ;
PRTSSN ;
 S SSN=$P(^DPT(PSODFN,0),"^",9),SSN=$E(SSN,$L(SSN)-3,$L(SSN))
 S PSOPATID=$E(PSONAM,1)_SSN
 S PSODIV=$P($G(^PSRX(RXP,2)),"^",9)
 S:PSODIV'="" PSODIV=$P($G(^PS(59,PSODIV,0)),"^",1)
 W ?17,"("_PSOPATID_")"_"  "_$E(PSODIV,1,15)
 Q
 ;------
LOCKED ;LIST OF LOCKED RX'S
 N JOBN,NAMSP,ZTDESC,ZTRTN,ZTQUEUED,ZTREQ,PSODV
 S NAMSP=$$NAMSP^PSOCIDC7
 S JOBN="CIDC ACTIVITY LOG CORRECTION - LOCKED PRESCRIPTIONS"
 L +^XTMP(NAMSP):0 I '$T D  Q
 .W !,JOBN_" job for PSO*7*239 is still running.  Halting..."
 L -^XTMP(NAMSP)
 W !!,"This report reflects all prescriptions where the activity and",!
 W "copay activity logs could not be corrected due to the Rx being locked."
 ;
 W !!,"You may queue the report to print, if you wish.",!
 ;
DVC2 ;
 K %ZIS,POP,IOP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! G DONE
QUEUE2 ;
 I $D(IO("Q")) S ZTRTN="START2^PSOCIDC9",ZTDESC=JOBN_" CIDC Activity Logs Corrections - Locked Rx's" D ^%ZTLOAD K %ZSI W !,"Report queued to print.",! G DONE
START2 ;
 U IO
 N BLDT,NAMSP,PSODFN,PSONAM,PSONAME,PSOOUT,PSODV,RXP,SSN,PSODIV,PSOPGCT,PSOOUT
 N CANCEL,JOBN,PSOPATID,PSOTOT,PSONCNT,PSORXN
 S NAMSP=$$NAMSP^PSOCIDC7
 S JOBN="CIDC ACTIVITY LOGS CORRECTION - Locked Rx report"
 S (PSOPGCT,PSONCNT,PSOOUT)=0,PSODV=$S($E(IOST)="C":"C",1:"P")
 S PSOPGLN=IOSL-7,PSOPGCT=1,RXP=""
 S BLDT=$P($G(^XTMP(NAMSP,0,"LAST")),"^",2)
 I '$D(DT) S DT=$$NOW^XLFDT
 D TITLE2
 F  S RXP=$O(^XTMP(NAMSP,0,"LOCKED RX",RXP)) Q:RXP=""  D
 . D FULL2 Q:$G(PSOOUT)
 . S PSONCNT=PSONCNT+1
 . S (DFN,PSODFN)=$P($G(^PSRX(RXP,0)),"^",2),PSORXN=$P($G(^PSRX(RXP,0)),"^")
 . S (PSONAME,PSONAM)=$P($G(^DPT(PSODFN,0)),"^") W !,$E(PSONAME,1,14)
 . D PRTSSN
 . W ?41," ",PSORXN
 . W:^XTMP(NAMSP,0,"LOCKED RX",RXP)'="" ?60,"CORRECTED"
 W !!,"Total number of prescriptions locked: ",PSONCNT,!
 G END
 Q
 ;
FULL2 ;
 I ($Y+7)>IOSL&('$G(PSOOUT)) D TITLE2
 Q
 ;
TITLE2 ;
 I $G(PSODV)="C",$G(PSOPGCT)'=1 W ! K DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSOOUT=1 Q
 ;
 W @IOF D
 . W !,"Patch PSO*7*239 - Locked Prescription Number Report",!!
 . W "Note that this report reflects all prescriptions where the activity and/or",!
 . W "copay activity logs could not be corrected. For detailed information,",!
 . W "please view the activity and copay activity log on the prescription.",!
 . W !!,"Note that FIXONE^PSOCIDC9 can be run from programmer's mode"
 . W !,"to correct individual prescriptions.",!!
 ;
 S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?70,"Page: ",PSOPGCT,!
 F MJT=1:1:79 W "="
 ;
 W !,"PATIENT NAME     (SSN)       DIV",?42,"RX# "
 W !,"---------------  -------  --------------",?42,"------------"
 S PSOPGCT=PSOPGCT+1
 Q
 ;
FIXONE ;FIX LOCKED RX'S
 N RXP,SEQ,CSEQ,PSOMSG,PSONTIM,PSOCHECK,FIXONE,PSOFONE,NAMSP
 W @IOF D
 . W !,"This function is used to correct individual prescriptions that were locked"
 . W !,"during the CIDC Activity Log clean-up process.  It verifies whether the"
 . W !,"prescription needs to be corrected, and if so corrects it.  If the Rx still"
 . W !,"cannot be locked for correction, a message stating such will be displayed."
 . W !,"Otherwise, a message stating that no correction is needed will be displayed.",!
 . W !,"For detailed information please view the activity and copay activity log on"
 . W !,"the prescription.  For a listing of locked Rx's, type D LOCKED^PSOCIDC9 at"
 . W !,"the programmer's prompt.",!
 ;
FIX2 ;
 S (PSOMSG,PSONTIM,FIXONE,PSOFONE)=""
 K DIC
 W ! S DIC="^PSRX(",DIC(0)="QEA" D ^DIC Q:Y<0
 S RXP=+Y,(DFN,PSODFN)=$P($G(^PSRX(RXP,0)),"^",2),PSONAM=$P($G(^DPT(PSODFN,0)),"^")
 W !,"For Patient: ",PSONAM
 S (PSOCHECK,SEQ,CSEQ)=0,NAMSP=$$NAMSP^PSOCIDC7
 I $D(^PSRX(RXP,"A",0)) F  S SEQ=$O(^PSRX(RXP,"A",SEQ)) Q:SEQ=""  I $G(^PSRX(RXP,"A",SEQ,0))["BKGD CIDC" S PSOCHECK=1
 I $D(^PSRX(RXP,"COPAY",0)) F  S CSEQ=$O(^PSRX(RXP,"COPAY",CSEQ)) Q:CSEQ=""  I $G(^PSRX(RXP,"COPAY",CSEQ,0))["BKGD CIDC" S PSOCHECK=1
 I 'PSOCHECK W !!,"No changes are needed for this prescription.",! G FIX2
 S FIXONE=1 D CHECK^PSOCIDC8
 I '$G(PSOFONE) W !,"Activity logs corrected.",!! S ^XTMP("PSOCIDC7",0,"LOCKED RX",RXP)=DUZ_"^"_$H
 G FIX2
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOCIDC9   7203     printed  Sep 23, 2025@20:01:38                                                                                                                                                                                                    Page 2
PSOCIDC9  ;BIR/LE - continuation of activity log corrections ;2/28/05 12:50pm
 +1       ;;7.0;OUTPATIENT PHARMACY;**239,250**;DEC 1997
 +2       ;
RPT       ;
 +1        NEW JOBN,NAMSP,ZTDESC,ZTRTN,ZTQUEUED,ZTREQ
 +2        SET NAMSP=$$NAMSP^PSOCIDC7
 +3        SET JOBN="CIDC ACTIVITY LOG CORRECTION"
 +4        LOCK +^XTMP(NAMSP):0
           IF '$TEST
               Begin DoDot:1
 +5                WRITE !,JOBN_" job for PSO*7*239 is still running.  Halting..."
               End DoDot:1
               QUIT 
 +6        LOCK -^XTMP(NAMSP)
 +7        WRITE !!,"This report reflects all prescriptions where the activity and"
 +8        WRITE !,"copay activity logs were corrected.  For detailed information,"
 +9        WRITE !,"please view the activity and copay logs on the prescriptions."
 +10      ;
 +11       WRITE !!,"You may queue the report to print, if you wish.",!
 +12      ;
DVC       ;
 +1        KILL %ZIS,POP,IOP
           SET %ZIS="QM"
           DO ^%ZIS
           IF $GET(POP)
               WRITE !!,"Nothing queued to print.",!
               GOTO DONE
QUEUE     ;
 +1        IF $DATA(IO("Q"))
               SET ZTRTN="START^PSOCIDC9"
               SET ZTDESC=JOBN_" CIDC Activity Logs Corrections"
               DO ^%ZTLOAD
               KILL %ZSI
               WRITE !,"Report queued to print.",!
               GOTO DONE
START     ;
 +1        USE IO
 +2        NEW BLDT,RXO,NAMSP,PSOFILL,PSODFN,PSONAM,PSOOUT,PSODV,RXP,SSN,PSODIV,PSODV
 +3        NEW CANCEL,JOBN,PSOPATID,PSOTOT
 +4        SET NAMSP=$$NAMSP^PSOCIDC7
 +5       ;****************************************************** for testing only - next line
 +6        SET JOBN="CIDC ACTIVITY LOGS CORRECTION"
 +7        SET PSOOUT=0
           SET PSODV=$SELECT($EXTRACT(IOST)="C":"C",1:"P")
 +8        SET PSOPGCT=0
           SET PSOPGLN=IOSL-7
           SET PSOPGCT=1
 +9        SET BLDT=$PIECE($GET(^XTMP(NAMSP,0,"LAST")),"^",2)
 +10       IF '$DATA(DT)
               SET DT=$$NOW^XLFDT
 +11       DO TITLE
 +12       SET (PSOTOT,PSONAM)=""
 +13       FOR 
               SET PSONAM=$ORDER(^XTMP(NAMSP,"LOG",PSONAM))
               if PSONAM=""
                   QUIT 
               Begin DoDot:1
 +14               SET PSODFN=""
 +15               FOR 
                       SET PSODFN=$ORDER(^XTMP(NAMSP,"LOG",PSONAM,PSODFN))
                       if PSODFN=""
                           QUIT 
                       Begin DoDot:2
 +16                       SET RXP=""
 +17                       FOR 
                               SET RXP=$ORDER(^XTMP(NAMSP,"LOG",PSONAM,PSODFN,RXP))
                               if RXP=""
                                   QUIT 
                               Begin DoDot:3
 +18                               DO FULL
                                   if $GET(PSOOUT)
                                       QUIT 
                                   SET PSONAME=$PIECE($GET(^DPT(PSODFN,0)),"^")
                                   SET PSOTOT=PSOTOT+1
 +19                               WRITE !,$EXTRACT(PSONAME,1,14)
 +20                               DO PRTSSN
 +21                               SET RXO=$PIECE($GET(^PSRX(RXP,0)),"^")
 +22      ;," (",PSOFILL,")"
                                   WRITE ?41," ",RXO
                               End DoDot:3
                       End DoDot:2
               End DoDot:1
 +23       if PSOTOT'=""
               WRITE !,"Total number of prescriptions modified: ",PSOTOT
 +24       GOTO END
 +25      ;
FULL      ;
 +1        IF ($Y+7)>IOSL&('$GET(PSOOUT))
               DO TITLE
 +2        QUIT 
 +3       ;
TITLE     ;
 +1        IF $GET(PSODV)="C"
               IF $GET(PSOPGCT)'=1
                   WRITE !
                   KILL DIR
                   SET DIR(0)="E"
                   DO ^DIR
                   KILL DIR
                   IF 'Y
                       SET PSOOUT=1
                       QUIT 
 +2       ;
 +3        WRITE @IOF
           Begin DoDot:1
 +4            WRITE !,"Patch PSO*7*239 - Corrected Activity and Copay Activity logs",!!
 +5            WRITE "Note that this report reflects all prescriptions where the activity and/or",!
 +6            WRITE "copay activity logs were corrected. For detailed information, please view",!
 +7            WRITE "the activity and copay activity log on the prescription.",!
           End DoDot:1
 +8       ;
 +9        SET Y=DT
           XECUTE ^DD("DD")
           WRITE !,"Date printed: ",Y,?70,"Page: ",PSOPGCT,!
 +10       FOR MJT=1:1:79
               WRITE "="
 +11      ;W !?55,"Updated",?67,"Updated"
 +12      ;W !,?55,"Activity",?67,"COPAY"
 +13      ;,?55,"Log",?67,"Activity Log"   ;,?55,"RELEASE DATE",?69,"REL   BILL"
           WRITE !,"PATIENT NAME     (SSN)       DIV",?42,"RX# "
 +14       WRITE !,"---------------  -------  --------------",?42,"------------"
 +15      ;W ?55,"------------",?67,"-----------"
 +16       SET PSOPGCT=PSOPGCT+1
 +17       QUIT 
 +18      ;
END       ;
 +1        IF '$GET(PSOOUT)
               IF $GET(PSODV)="C"
                   WRITE !!,"** End of Report **"
                   KILL DIR
                   SET DIR(0)="E"
                   SET DIR("A")="Press Return to continue"
                   DO ^DIR
                   KILL DIR
 +2        IF $GET(PSODV)="C"
               WRITE !
 +3       IF '$TEST
               WRITE @IOF
DONE      ;
 +1        KILL MJT,PSOPGCT,PSOPGLN,Y,DIR,X,IOP,POP,IO("Q"),DIRUT,DUOUT,DTOUT
 +2        DO ^%ZISC
           if $DATA(ZTQUEUED)
               SET ZTREQ="@"
 +3        QUIT 
 +4       ;
PRTSSN    ;
 +1        SET SSN=$PIECE(^DPT(PSODFN,0),"^",9)
           SET SSN=$EXTRACT(SSN,$LENGTH(SSN)-3,$LENGTH(SSN))
 +2        SET PSOPATID=$EXTRACT(PSONAM,1)_SSN
 +3        SET PSODIV=$PIECE($GET(^PSRX(RXP,2)),"^",9)
 +4        if PSODIV'=""
               SET PSODIV=$PIECE($GET(^PS(59,PSODIV,0)),"^",1)
 +5        WRITE ?17,"("_PSOPATID_")"_"  "_$EXTRACT(PSODIV,1,15)
 +6        QUIT 
 +7       ;------
LOCKED    ;LIST OF LOCKED RX'S
 +1        NEW JOBN,NAMSP,ZTDESC,ZTRTN,ZTQUEUED,ZTREQ,PSODV
 +2        SET NAMSP=$$NAMSP^PSOCIDC7
 +3        SET JOBN="CIDC ACTIVITY LOG CORRECTION - LOCKED PRESCRIPTIONS"
 +4        LOCK +^XTMP(NAMSP):0
           IF '$TEST
               Begin DoDot:1
 +5                WRITE !,JOBN_" job for PSO*7*239 is still running.  Halting..."
               End DoDot:1
               QUIT 
 +6        LOCK -^XTMP(NAMSP)
 +7        WRITE !!,"This report reflects all prescriptions where the activity and",!
 +8        WRITE "copay activity logs could not be corrected due to the Rx being locked."
 +9       ;
 +10       WRITE !!,"You may queue the report to print, if you wish.",!
 +11      ;
DVC2      ;
 +1        KILL %ZIS,POP,IOP
           SET %ZIS="QM"
           DO ^%ZIS
           IF $GET(POP)
               WRITE !!,"Nothing queued to print.",!
               GOTO DONE
QUEUE2    ;
 +1        IF $DATA(IO("Q"))
               SET ZTRTN="START2^PSOCIDC9"
               SET ZTDESC=JOBN_" CIDC Activity Logs Corrections - Locked Rx's"
               DO ^%ZTLOAD
               KILL %ZSI
               WRITE !,"Report queued to print.",!
               GOTO DONE
START2    ;
 +1        USE IO
 +2        NEW BLDT,NAMSP,PSODFN,PSONAM,PSONAME,PSOOUT,PSODV,RXP,SSN,PSODIV,PSOPGCT,PSOOUT
 +3        NEW CANCEL,JOBN,PSOPATID,PSOTOT,PSONCNT,PSORXN
 +4        SET NAMSP=$$NAMSP^PSOCIDC7
 +5        SET JOBN="CIDC ACTIVITY LOGS CORRECTION - Locked Rx report"
 +6        SET (PSOPGCT,PSONCNT,PSOOUT)=0
           SET PSODV=$SELECT($EXTRACT(IOST)="C":"C",1:"P")
 +7        SET PSOPGLN=IOSL-7
           SET PSOPGCT=1
           SET RXP=""
 +8        SET BLDT=$PIECE($GET(^XTMP(NAMSP,0,"LAST")),"^",2)
 +9        IF '$DATA(DT)
               SET DT=$$NOW^XLFDT
 +10       DO TITLE2
 +11       FOR 
               SET RXP=$ORDER(^XTMP(NAMSP,0,"LOCKED RX",RXP))
               if RXP=""
                   QUIT 
               Begin DoDot:1
 +12               DO FULL2
                   if $GET(PSOOUT)
                       QUIT 
 +13               SET PSONCNT=PSONCNT+1
 +14               SET (DFN,PSODFN)=$PIECE($GET(^PSRX(RXP,0)),"^",2)
                   SET PSORXN=$PIECE($GET(^PSRX(RXP,0)),"^")
 +15               SET (PSONAME,PSONAM)=$PIECE($GET(^DPT(PSODFN,0)),"^")
                   WRITE !,$EXTRACT(PSONAME,1,14)
 +16               DO PRTSSN
 +17               WRITE ?41," ",PSORXN
 +18               if ^XTMP(NAMSP,0,"LOCKED RX",RXP)'=""
                       WRITE ?60,"CORRECTED"
               End DoDot:1
 +19       WRITE !!,"Total number of prescriptions locked: ",PSONCNT,!
 +20       GOTO END
 +21       QUIT 
 +22      ;
FULL2     ;
 +1        IF ($Y+7)>IOSL&('$GET(PSOOUT))
               DO TITLE2
 +2        QUIT 
 +3       ;
TITLE2    ;
 +1        IF $GET(PSODV)="C"
               IF $GET(PSOPGCT)'=1
                   WRITE !
                   KILL DIR
                   SET DIR(0)="E"
                   DO ^DIR
                   KILL DIR
                   IF 'Y
                       SET PSOOUT=1
                       QUIT 
 +2       ;
 +3        WRITE @IOF
           Begin DoDot:1
 +4            WRITE !,"Patch PSO*7*239 - Locked Prescription Number Report",!!
 +5            WRITE "Note that this report reflects all prescriptions where the activity and/or",!
 +6            WRITE "copay activity logs could not be corrected. For detailed information,",!
 +7            WRITE "please view the activity and copay activity log on the prescription.",!
 +8            WRITE !!,"Note that FIXONE^PSOCIDC9 can be run from programmer's mode"
 +9            WRITE !,"to correct individual prescriptions.",!!
           End DoDot:1
 +10      ;
 +11       SET Y=DT
           XECUTE ^DD("DD")
           WRITE !,"Date printed: ",Y,?70,"Page: ",PSOPGCT,!
 +12       FOR MJT=1:1:79
               WRITE "="
 +13      ;
 +14       WRITE !,"PATIENT NAME     (SSN)       DIV",?42,"RX# "
 +15       WRITE !,"---------------  -------  --------------",?42,"------------"
 +16       SET PSOPGCT=PSOPGCT+1
 +17       QUIT 
 +18      ;
FIXONE    ;FIX LOCKED RX'S
 +1        NEW RXP,SEQ,CSEQ,PSOMSG,PSONTIM,PSOCHECK,FIXONE,PSOFONE,NAMSP
 +2        WRITE @IOF
           Begin DoDot:1
 +3            WRITE !,"This function is used to correct individual prescriptions that were locked"
 +4            WRITE !,"during the CIDC Activity Log clean-up process.  It verifies whether the"
 +5            WRITE !,"prescription needs to be corrected, and if so corrects it.  If the Rx still"
 +6            WRITE !,"cannot be locked for correction, a message stating such will be displayed."
 +7            WRITE !,"Otherwise, a message stating that no correction is needed will be displayed.",!
 +8            WRITE !,"For detailed information please view the activity and copay activity log on"
 +9            WRITE !,"the prescription.  For a listing of locked Rx's, type D LOCKED^PSOCIDC9 at"
 +10           WRITE !,"the programmer's prompt.",!
           End DoDot:1
 +11      ;
FIX2      ;
 +1        SET (PSOMSG,PSONTIM,FIXONE,PSOFONE)=""
 +2        KILL DIC
 +3        WRITE !
           SET DIC="^PSRX("
           SET DIC(0)="QEA"
           DO ^DIC
           if Y<0
               QUIT 
 +4        SET RXP=+Y
           SET (DFN,PSODFN)=$PIECE($GET(^PSRX(RXP,0)),"^",2)
           SET PSONAM=$PIECE($GET(^DPT(PSODFN,0)),"^")
 +5        WRITE !,"For Patient: ",PSONAM
 +6        SET (PSOCHECK,SEQ,CSEQ)=0
           SET NAMSP=$$NAMSP^PSOCIDC7
 +7        IF $DATA(^PSRX(RXP,"A",0))
               FOR 
                   SET SEQ=$ORDER(^PSRX(RXP,"A",SEQ))
                   if SEQ=""
                       QUIT 
                   IF $GET(^PSRX(RXP,"A",SEQ,0))["BKGD CIDC"
                       SET PSOCHECK=1
 +8        IF $DATA(^PSRX(RXP,"COPAY",0))
               FOR 
                   SET CSEQ=$ORDER(^PSRX(RXP,"COPAY",CSEQ))
                   if CSEQ=""
                       QUIT 
                   IF $GET(^PSRX(RXP,"COPAY",CSEQ,0))["BKGD CIDC"
                       SET PSOCHECK=1
 +9        IF 'PSOCHECK
               WRITE !!,"No changes are needed for this prescription.",!
               GOTO FIX2
 +10       SET FIXONE=1
           DO CHECK^PSOCIDC8
 +11       IF '$GET(PSOFONE)
               WRITE !,"Activity logs corrected.",!!
               SET ^XTMP("PSOCIDC7",0,"LOCKED RX",RXP)=DUZ_"^"_$HOROLOG
 +12       GOTO FIX2
 +13       QUIT