PSORXVW1.m

PSORXVW1 ;BIR/SAB-view prescription con't ;04-Apr-2013 22:42;PLS

 ;;7.0;OUTPATIENT PHARMACY;**35,47,46,71,99,117,156,193,210,148,258,260,240,281,1015**;DEC 1997;Build 62

 ;External reference to ^DD(52 supported by DBIA 999

 ;External reference to ^VA(200 supported by DBIA 10060

 ;PSO*210 add call to WORDWRAP api

 ;

 ; Modified - IHS/MSC/PLS - 04/04/13 - Lines ACT+10 and ACT+12

 ;

 I $P($G(^PSRX(RXN,"OR1")),"^",6) D

 .K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=$P(^PSRX(RXN,"OR1"),"^",6) D ^DIC

 .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="           Filled By: "_$P(Y,"^",2) K DIC,X,Y

 I $P($G(^PSRX(RXN,"OR1")),"^",7) D

 .K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=$P(^PSRX(RXN,"OR1"),"^",7) D ^DIC

 .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="          Checked By: "_$P(Y,"^",2) K DIC,X,Y

 K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=$P(RX0,"^",16) D ^DIC

 S $P(RN," ",35)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="   Entry By: "_$P(Y,"^",2)_$E(RN,$L($P(Y,"^",2))+1,35)

 S Y=$P(RX2,"^") X ^DD("DD")

 S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_"Entry Date: "_$E($P(RX2,"^"),4,5)_"/"_$E($P(RX2,"^"),6,7)_"/"_$E($P(RX2,"^"),2,3)_" "_$P(Y,"@",2) K RN

 S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" " ;,IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="="

 S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Original Fill Released: " I $P(RX2,"^",13) S DTT=$P(RX2,"^",13) D DAT S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_DAT K DAT,DTT

 I $P(RX2,"^",15) S DTT=$P(RX2,"^",15) D DAT S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_"(Returned to Stock "_DAT_")" K DAT,DTT

 S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_"      Routing: "_$S($P(RX0,"^",11)="W":"Window",1:"Mail")

 I $G(^PSRX(DA,"H"))]"",$P(^("STA"),"^")=3 D HLD

 D RF,PAR,ACT,COPAY^PSORXVW2,LBL,ECME^PSOORAL1,^PSORXVW2:$O(^PSRX(DA,4,0))

 Q

ACT ;activity log

 ;IHS/MSC/PLS - 04/04/13 - Added support for Reissue at lines ACT+10 and ACT+12

 N CNT

 S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Activity Log:"

 S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="#   Date        Reason         Rx Ref         Initiator Of Activity",IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="="

 I '$O(^PSRX(DA,"A",0)) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There's NO Activity to report" Q

 S CNT=0

 F N=0:0 S N=$O(^PSRX(DA,"A",N)) Q:'N  S P1=^(N,0),DTT=P1\1 D DAT D

 .I $P(P1,"^",2)="M" Q

 .S IEN=IEN+1,CNT=CNT+1,^TMP("PSOAL",$J,IEN,0)=CNT_"   "_DAT_"    ",$P(RN," ",15)=" ",REA=$P(P1,"^",2)

 .S REA=$F("HUCELPRWSIVDABXGKNMZ",REA)-1

 .I REA D

 ..S STA=$P("HOLD^UNHOLD^DISCONTINUED^EDIT^RENEWED^PARTIAL^REINSTATE^REPRINT^SUSPENSE^RETURNED^INTERVENTION^DELETED^DRUG INTERACTION^PROCESSED^X-INTERFACE^PATIENT INSTR.^PKI/DEA^DISP COMPLETED^ECME^REISSUE^","^",REA)

 ..S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_STA_$E(RN,$L(STA)+1,15)

 .E  S $P(STA," ",15)=" ",^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_STA

 .K STA,RN S $P(RN," ",15)=" ",RF=+$P(P1,"^",4)

 .S RFT=$S(RF>0&(RF<6):"REFILL "_RF,RF=6:"PARTIAL",RF>6:"REFILL "_(RF-1),1:"ORIGINAL")

 .K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=$P(P1,"^",3) D ^DIC

 .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_RFT_$E(RN,$L(RFT)+1,15)_$S(+Y:$P(Y,"^",2),1:$P(P1,"^",3))

 .;S:$P(P1,"^",5)]"" IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Comments: "_$P(P1,"^",5)

 .I $P(P1,"^",5)]"" N PSOACBRK,PSOACBRV D

 ..S PSOACBRV=$P(P1,"^",5)

 ..;PSO*7*240 Use fileman to format

 ..K ^UTILITY($J,"W") S X="Comments: "_PSOACBRV,(DIWR,DIWL)=1,DIWF="C80" D ^DIWP F I=1:1:^UTILITY($J,"W",1) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=$G(^UTILITY($J,"W",1,I,0))

 .I $G(^PSRX(DA,"A",N,1))]"" S IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0)," ",5)=$P(^PSRX(DA,"A",N,1),"^") I $P(^PSRX(DA,"A",N,1),"^",2)]"" S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_":"_$P(^PSRX(DA,"A",N,1),"^",2)

 .I $O(^PSRX(DA,"A",N,2,0)) F I=0:0 S I=$O(^PSRX(RXN,"A",N,2,I)) Q:'I  S MIG=^PSRX(RXN,"A",N,2,I,0) D

 ..F SG=1:1:$L(MIG) S:$L(^TMP("PSOAL",$J,IEN,0)_" "_$P(MIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0)," ",9)=" " S:$P(MIG," ",SG)'="" ^TMP("PSOAL",$J,IEN,0)=$G(^TMP("PSOAL",$J,IEN,0))_" "_$P(MIG," ",SG)

 K MIG,SG,I,^UTILITY($J,"W"),DIWF,DIWL,DIWR

 Q

LBL ;label log

 S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Label Log:"

 S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="#   Date        Rx Ref                    Printed By",IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="="

 I '$O(^PSRX(DA,"L",0)) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There are NO Labels printed." Q

 F L1=0:0 S L1=$O(^PSRX(DA,"L",L1)) Q:'L1  S LBL=^PSRX(DA,"L",L1,0),DTT=$P(^(0),"^") D DAT D

 .S $P(RN," ",26)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=L1_"   "_DAT_"    ",RFT=$S($P(LBL,"^",2):"REFILL "_$P(LBL,"^",2),1:"ORIGINAL"),RFT=RFT_$E(RN,$L(RFT)+1,26)

 .K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=$P(LBL,"^",4) D ^DIC

 .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_RFT_$P(Y,"^",2),IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Comments: "_$P(LBL,"^",3)

 K DIC,X,Y Q

RF ;refill log

 S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Refill Log:"

 S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="#  Log Date   Refill Date  Qty               Routing  Lot #       Pharmacist",IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="="

 S (RF,PL)=0 F RF=0:0 S RF=$O(^PSRX(DA,1,RF)) Q:'RF  S PL=PL+1

 I 'PL S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There are NO Refills For this  Prescription" Q

 F N=0:0 S N=$O(^PSRX(DA,1,N)) Q:'N  S P1=^(N,0) D

 .S DTT=$P(P1,"^",8)\1 D DAT S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=N_"   "_DAT_"   "

 .S DTT=$P(P1,"^"),$P(RN," ",10)=" " D DAT

 .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_DAT_"     "_$P(P1,"^",4)_$E("               ",$L($P(P1,"^",4))+1,15)_"  "_$S($P(P1,"^",2)="M":"Mail",1:"Window")_" "_$P(P1,"^",6)_$E(RN,$L($P(P1,"^",6))+1,12)

 .K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=+$P(P1,"^",5) D ^DIC

 .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_$E($S(+Y:$P(Y,"^",2),1:""),1,16) K DIC,X,Y

 .S PSDIV=$S($D(^PS(59,+$P(P1,"^",9),0)):$P(^(0),"^",6),1:"Unknown"),IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Division: "_PSDIV_$E("        ",$L(PSDIV)+1,8)_"  "

 .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_"Dispensed: "_$S($P(P1,"^",19):$E($P(P1,"^",19),4,5)_"/"_$E($P(P1,"^",19),6,7)_"/"_$E($P(P1,"^",19),2,3),1:"")_"  "

 .S RTS=$S($P(P1,"^",16):" Returned to Stock: "_$E($P(P1,"^",16),4,5)_"/"_$E($P(P1,"^",16),6,7)_"/"_$E($P(P1,"^",16),2,3),1:" Released: "_$S($$RXRLDT^PSOBPSUT(DA,N):$$FMTE^XLFDT($$RXRLDT^PSOBPSUT(DA,N)\1,2),1:""))

 .I $$STATUS^PSOBPSUT(DA,N)'="",$$RXRLDT^PSOBPSUT(DA,N) S RTS=RTS_"  NDC: "_$$GETNDC^PSONDCUT(DA,N)

 .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_RTS

 .S:$P(P1,"^",3)]"" IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="   Remarks: "_$P(P1,"^",3)

 K RTS Q

PAR ;partial log

 S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Partial Fills:"

 S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="#   Log Date   Date     Qty              Routing    Lot #        Pharmacist",IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="="

 I '$O(^PSRX(DA,"P",0)) S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="There are NO Partials for this Prescription" Q

 S N=0 F  S N=$O(^PSRX(DA,"P",N)) Q:'N  S P1=^(N,0),DTT=$P(P1,"^",8)\1 D DAT D

 .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)=N_"   "_DAT_"  ",QTY=$P(P1,"^",4)_$E("               ",$L($P(P1,"^",4))+1,15)

 .S DTT=$P(P1,"^") D DAT S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_DAT_"  "_QTY_"  "

 .S PSDIV=$S($D(^PS(59,+$P(P1,"^",9),0)):$P(^(0),"^",6),1:"UNKNOWN"),PSDIV=PSDIV_$E("        ",$L(PSDIV)+1,8)

 .S MW=$S($P(P1,"^",2)="M":"Mail",1:"Window"),MW=MW_$E("          ",$L(MW)+1,10)

 .K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=+$P(P1,"^",16) D ^DIC

 .S ^TMP("PSOAL",$J,IEN,0)=^TMP("PSOAL",$J,IEN,0)_MW_"  "_$P(P1,"^",6)_$E("            ",$L($P(P1,"^",6))+1,10)_$E($S(+Y:$P(Y,"^",2),1:""),1,16)

 .S RTS=$S($P(P1,"^",16):" RETURNED TO STOCK: "_$E($P(P1,"^",16),4,5)_"/"_$E($P(P1,"^",16),6,7)_"/"_$E($P(P1,"^",16),2,3),1:" RELEASED: "_$S($P(P1,"^",19):$E($P(P1,"^",19),4,5)_"/"_$E($P(P1,"^",19),6,7)_"/"_$E($P(P1,"^",19),2,3),1:""))

 .K DIC,X,Y S DIC="^VA(200,",DIC(0)="N,Z",X=$P(P1,"^",7) D ^DIC

 .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Division: "_PSDIV_" "_RTS ;_"      Entry By: "_$P(Y,"^",2) K DIC,X,Y

 .S:$P(P1,"^",3)]"" IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="  REMARKS: "_$P(P1,"^",3) K RTS

 Q

HLD ;hold info

 S DTT=$P(^PSRX(DA,"H"),"^",3) D DAT S HLDR=$P(^DD(52,99,0),"^",3),HLDR=$S($P(^PSRX(DA,"H"),"^")'>8:$P(HLDR,";",$P(^PSRX(DA,"H"),"^")),1:$P(HLDR,";",9)),HLDR=$P(HLDR,":",2)

 S $P(RN," ",60)=" ",IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Hold Reason: "_HLDR_$E(RN,$L("Hold Reason: "_HLDR)+1,60)_"Hold Date: "_DAT S:$P(^PSRX(DA,"H"),"^",2)]"" IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Hold Comments: "_$P(^PSRX(DA,"H"),"^",2)

 K RN,DAT,DTT,HLDR

 Q

DAT S DAT="",DTT=DTT\1 Q:DTT'?7N  S DAT=$E(DTT,4,5)_"/"_$E(DTT,6,7)_"/"_$E(DTT,2,3)

 Q

INST ;formats instruction from front door

 I $O(^PSRX(DA,"PI",0)) D

 .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="        Instructions:"

 .S T=0 F  S T=$O(^PSRX(RXN,"PI",T)) Q:'T  D                  ;PSO*210

 ..S MIG=^PSRX(RXN,"PI",T,0)

 ..D WORDWRAP^PSOUTLA2(MIG,.IEN,$NA(^TMP("PSOAL",$J)),21)

 K T,TY,MIG,SG

 Q

PC ;displays provider comments

 I $O(^PSRX(DA,"PRC",0)) D

 .S IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="   Provider Comments:"

 .S T=0 F  S T=$O(^PSRX(RXN,"PRC",T)) Q:'T  D                 ;PSO*210

 ..S MIG=^PSRX(RXN,"PRC",T,0)

 ..D WORDWRAP^PSOUTLA2(MIG,.IEN,$NA(^TMP("PSOAL",$J)),21)

 K T,TY,MIG,SG

 Q

DOSE ;displays dosing instruction for both simple and complex Rxs.

 D DOSE^PSORXVW2

 Q

 ;

HLP ; Help Text for the VIEW PRESCRIPTION prompt

 W !," A prescription number or ECME # may be entered.  The ECME"

 W !," number must be entered in E.NNNNNNN format, where NNNNNNN"

 W !," is the prescription ECME # (example: E.0289332).  Or just"

 D LKP("?")

 Q

LKP(INPUT) ; - Peforms Lookup on the PRESCRIPTION file

 N DIC,X,Y

 S DIC="^PSRX(",DIC(0)="QE",D="B",X=INPUT

 S DIC("S")="I $P($G(^(0)),""^"",2),$D(^(""STA"")),$P($G(^(""STA"")),""^"")'=13"

 D IX^DIC

 Q Y

PSORXVW1  ;BIR/SAB-view prescription con't ;04-Apr-2013 22:42;PLS

 +1       ;;7.0;OUTPATIENT PHARMACY;**35,47,46,71,99,117,156,193,210,148,258,260,240,281,1015**;DEC 1997;Build 62

 +2       ;External reference to ^DD(52 supported by DBIA 999

 +3       ;External reference to ^VA(200 supported by DBIA 10060

 +4       ;PSO*210 add call to WORDWRAP api

 +5       ;

 +6       ; Modified - IHS/MSC/PLS - 04/04/13 - Lines ACT+10 and ACT+12

 +7       ;

 +8        IF $PIECE($GET(^PSRX(RXN,"OR1")),"^",6)

               Begin DoDot:1

 +9                KILL DIC,X,Y

                   SET DIC="^VA(200,"

                   SET DIC(0)="N,Z"

                   SET X=$PIECE(^PSRX(RXN,"OR1"),"^",6)

                   DO ^DIC

 +10               SET IEN=IEN+1

                   SET ^TMP("PSOAL",$JOB,IEN,0)="           Filled By: "_$PIECE(Y,"^",2)

                   KILL DIC,X,Y

               End DoDot:1

 +11       IF $PIECE($GET(^PSRX(RXN,"OR1")),"^",7)

               Begin DoDot:1

 +12               KILL DIC,X,Y

                   SET DIC="^VA(200,"

                   SET DIC(0)="N,Z"

                   SET X=$PIECE(^PSRX(RXN,"OR1"),"^",7)

                   DO ^DIC

 +13               SET IEN=IEN+1

                   SET ^TMP("PSOAL",$JOB,IEN,0)="          Checked By: "_$PIECE(Y,"^",2)

                   KILL DIC,X,Y

               End DoDot:1

 +14       KILL DIC,X,Y

           SET DIC="^VA(200,"

           SET DIC(0)="N,Z"

           SET X=$PIECE(RX0,"^",16)

           DO ^DIC

 +15       SET $PIECE(RN," ",35)=" "

           SET IEN=IEN+1

           SET ^TMP("PSOAL",$JOB,IEN,0)="   Entry By: "_$PIECE(Y,"^",2)_$EXTRACT(RN,$LENGTH($PIECE(Y,"^",2))+1,35)

 +16       SET Y=$PIECE(RX2,"^")

           XECUTE ^DD("DD")

 +17       SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_"Entry Date: "_$EXTRACT($PIECE(RX2,"^"),4,5)_"/"_$EXTRACT($PIECE(RX2,"^"),6,7)_"/"_$EXTRACT($PIECE(RX2,"^"),2,3)_" "_$PIECE(Y,"@",2)

           KILL RN

 +18      ;,IEN=IEN+1,$P(^TMP("PSOAL",$J,IEN,0),"=",79)="="

           SET IEN=IEN+1

           SET ^TMP("PSOAL",$JOB,IEN,0)=" "

 +19       SET IEN=IEN+1

           SET ^TMP("PSOAL",$JOB,IEN,0)="Original Fill Released: "

           IF $PIECE(RX2,"^",13)

               SET DTT=$PIECE(RX2,"^",13)

               DO DAT

               SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_DAT

               KILL DAT,DTT

 +20       IF $PIECE(RX2,"^",15)

               SET DTT=$PIECE(RX2,"^",15)

               DO DAT

               SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_"(Returned to Stock "_DAT_")"

               KILL DAT,DTT

 +21       SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_"      Routing: "_$SELECT($PIECE(RX0,"^",11)="W":"Window",1:"Mail")

 +22       IF $GET(^PSRX(DA,"H"))]""

               IF $PIECE(^("STA"),"^")=3

                   DO HLD

 +23       DO RF

           DO PAR

           DO ACT

           DO COPAY^PSORXVW2

           DO LBL

           DO ECME^PSOORAL1

           IF $ORDER(^PSRX(DA,4,0))

               DO ^PSORXVW2

 +24       QUIT 

ACT       ;activity log

 +1       ;IHS/MSC/PLS - 04/04/13 - Added support for Reissue at lines ACT+10 and ACT+12

 +2        NEW CNT

 +3        SET IEN=IEN+1

           SET ^TMP("PSOAL",$JOB,IEN,0)=" "

           SET IEN=IEN+1

           SET ^TMP("PSOAL",$JOB,IEN,0)="Activity Log:"

 +4        SET IEN=IEN+1

           SET ^TMP("PSOAL",$JOB,IEN,0)="#   Date        Reason         Rx Ref         Initiator Of Activity"

           SET IEN=IEN+1

           SET $PIECE(^TMP("PSOAL",$JOB,IEN,0),"=",79)="="

 +5        IF '$ORDER(^PSRX(DA,"A",0))

               SET IEN=IEN+1

               SET ^TMP("PSOAL",$JOB,IEN,0)="There's NO Activity to report"

               QUIT 

 +6        SET CNT=0

 +7        FOR N=0:0

               SET N=$ORDER(^PSRX(DA,"A",N))

               IF 'N

                   QUIT 

               SET P1=^(N,0)

               SET DTT=P1\1

               DO DAT

               Begin DoDot:1

 +8                IF $PIECE(P1,"^",2)="M"

                       QUIT 

 +9                SET IEN=IEN+1

                   SET CNT=CNT+1

                   SET ^TMP("PSOAL",$JOB,IEN,0)=CNT_"   "_DAT_"    "

                   SET $PIECE(RN," ",15)=" "

                   SET REA=$PIECE(P1,"^",2)

 +10               SET REA=$FIND("HUCELPRWSIVDABXGKNMZ",REA)-1

 +11               IF REA

                       Begin DoDot:2

 +12                       SET STA=$PIECE("HOLD^UNHOLD^DISCONTINUED^EDIT^RENEWED^PARTIAL^REINSTATE^REPRINT^SUSPENSE^RETURNED^INTERVENTION^DELETED^DRUG INTERACTION^PROCESSED^X-INTERFACE^PATIENT INSTR.^PKI/DEA^DISP COMPLETED^ECME^REISSUE^","^",REA)

 +13                       SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_STA_$EXTRACT(RN,$LENGTH(STA)+1,15)

                       End DoDot:2

 +14              IF '$TEST

                       SET $PIECE(STA," ",15)=" "

                       SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_STA

 +15               KILL STA,RN

                   SET $PIECE(RN," ",15)=" "

                   SET RF=+$PIECE(P1,"^",4)

 +16               SET RFT=$SELECT(RF>0&(RF<6):"REFILL "_RF,RF=6:"PARTIAL",RF>6:"REFILL "_(RF-1),1:"ORIGINAL")

 +17               KILL DIC,X,Y

                   SET DIC="^VA(200,"

                   SET DIC(0)="N,Z"

                   SET X=$PIECE(P1,"^",3)

                   DO ^DIC

 +18               SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_RFT_$EXTRACT(RN,$LENGTH(RFT)+1,15)_$SELECT(+Y:$PIECE(Y,"^",2),1:$PIECE(P1,"^",3))

 +19      ;S:$P(P1,"^",5)]"" IEN=IEN+1,^TMP("PSOAL",$J,IEN,0)="Comments: "_$P(P1,"^",5)

 +20               IF $PIECE(P1,"^",5)]""

                       NEW PSOACBRK,PSOACBRV

                       Begin DoDot:2

 +21                       SET PSOACBRV=$PIECE(P1,"^",5)

 +22      ;PSO*7*240 Use fileman to format

 +23                       KILL ^UTILITY($JOB,"W")

                           SET X="Comments: "_PSOACBRV

                           SET (DIWR,DIWL)=1

                           SET DIWF="C80"

                           DO ^DIWP

                           FOR I=1:1:^UTILITY($JOB,"W",1)

                               SET IEN=IEN+1

                               SET ^TMP("PSOAL",$JOB,IEN,0)=$GET(^UTILITY($JOB,"W",1,I,0))

                       End DoDot:2

 +24               IF $GET(^PSRX(DA,"A",N,1))]""

                       SET IEN=IEN+1

                       SET $PIECE(^TMP("PSOAL",$JOB,IEN,0)," ",5)=$PIECE(^PSRX(DA,"A",N,1),"^")

                       IF $PIECE(^PSRX(DA,"A",N,1),"^",2)]""

                           SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_":"_$PIECE(^PSRX(DA,"A",N,1),"^",2)

 +25               IF $ORDER(^PSRX(DA,"A",N,2,0))

                       FOR I=0:0

                           SET I=$ORDER(^PSRX(RXN,"A",N,2,I))

                           IF 'I

                               QUIT 

                           SET MIG=^PSRX(RXN,"A",N,2,I,0)

                           Begin DoDot:2

 +26                           FOR SG=1:1:$LENGTH(MIG)

                                   IF $LENGTH(^TMP("PSOAL",$JOB,IEN,0)_" "_$PIECE(MIG," ",SG))>80

                                       SET IEN=IEN+1

                                       SET $PIECE(^TMP("PSOAL",$JOB,IEN,0)," ",9)=" "

                                   IF $PIECE(MIG," ",SG)'=""

                                       SET ^TMP("PSOAL",$JOB,IEN,0)=$GET(^TMP("PSOAL",$JOB,IEN,0))_" "_$PIECE(MIG," ",SG)

                           End DoDot:2

               End DoDot:1

 +27       KILL MIG,SG,I,^UTILITY($JOB,"W"),DIWF,DIWL,DIWR

 +28       QUIT 

LBL       ;label log

 +1        SET IEN=IEN+1

           SET ^TMP("PSOAL",$JOB,IEN,0)=" "

           SET IEN=IEN+1

           SET ^TMP("PSOAL",$JOB,IEN,0)="Label Log:"

 +2        SET IEN=IEN+1

           SET ^TMP("PSOAL",$JOB,IEN,0)="#   Date        Rx Ref                    Printed By"

           SET IEN=IEN+1

           SET $PIECE(^TMP("PSOAL",$JOB,IEN,0),"=",79)="="

 +3        IF '$ORDER(^PSRX(DA,"L",0))

               SET IEN=IEN+1

               SET ^TMP("PSOAL",$JOB,IEN,0)="There are NO Labels printed."

               QUIT 

 +4        FOR L1=0:0

               SET L1=$ORDER(^PSRX(DA,"L",L1))

               IF 'L1

                   QUIT 

               SET LBL=^PSRX(DA,"L",L1,0)

               SET DTT=$PIECE(^(0),"^")

               DO DAT

               Begin DoDot:1

 +5                SET $PIECE(RN," ",26)=" "

                   SET IEN=IEN+1

                   SET ^TMP("PSOAL",$JOB,IEN,0)=L1_"   "_DAT_"    "

                   SET RFT=$SELECT($PIECE(LBL,"^",2):"REFILL "_$PIECE(LBL,"^",2),1:"ORIGINAL")

                   SET RFT=RFT_$EXTRACT(RN,$LENGTH(RFT)+1,26)

 +6                KILL DIC,X,Y

                   SET DIC="^VA(200,"

                   SET DIC(0)="N,Z"

                   SET X=$PIECE(LBL,"^",4)

                   DO ^DIC

 +7                SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_RFT_$PIECE(Y,"^",2)

                   SET IEN=IEN+1

                   SET ^TMP("PSOAL",$JOB,IEN,0)="Comments: "_$PIECE(LBL,"^",3)

               End DoDot:1

 +8        KILL DIC,X,Y

           QUIT 

RF        ;refill log

 +1        SET IEN=IEN+1

           SET ^TMP("PSOAL",$JOB,IEN,0)=" "

           SET IEN=IEN+1

           SET ^TMP("PSOAL",$JOB,IEN,0)="Refill Log:"

 +2        SET IEN=IEN+1

           SET ^TMP("PSOAL",$JOB,IEN,0)="#  Log Date   Refill Date  Qty               Routing  Lot #       Pharmacist"

           SET IEN=IEN+1

           SET $PIECE(^TMP("PSOAL",$JOB,IEN,0),"=",79)="="

 +3        SET (RF,PL)=0

           FOR RF=0:0

               SET RF=$ORDER(^PSRX(DA,1,RF))

               IF 'RF

                   QUIT 

               SET PL=PL+1

 +4        IF 'PL

               SET IEN=IEN+1

               SET ^TMP("PSOAL",$JOB,IEN,0)="There are NO Refills For this  Prescription"

               QUIT 

 +5        FOR N=0:0

               SET N=$ORDER(^PSRX(DA,1,N))

               IF 'N

                   QUIT 

               SET P1=^(N,0)

               Begin DoDot:1

 +6                SET DTT=$PIECE(P1,"^",8)\1

                   DO DAT

                   SET IEN=IEN+1

                   SET ^TMP("PSOAL",$JOB,IEN,0)=N_"   "_DAT_"   "

 +7                SET DTT=$PIECE(P1,"^")

                   SET $PIECE(RN," ",10)=" "

                   DO DAT

 +8               SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_DAT_"     "_$PIECE(P1,"^",4)_$EXTRACT("               ",$LENGTH($PIECE(P1,"^",4))+1,15)_"  "_$SELECT($PIECE(P1,"^",2)="M":"Mail",1:"Window")_" "_$PIECE(P1,"^",6)_$EXTRACT(RN,...

                   ... $LENGTH($PIECE(P1,"^",6))+1,12)

 +9                KILL DIC,X,Y

                   SET DIC="^VA(200,"

                   SET DIC(0)="N,Z"

                   SET X=+$PIECE(P1,"^",5)

                   DO ^DIC

 +10               SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_$EXTRACT($SELECT(+Y:$PIECE(Y,"^",2),1:""),1,16)

                   KILL DIC,X,Y

 +11               SET PSDIV=$SELECT($DATA(^PS(59,+$PIECE(P1,"^",9),0)):$PIECE(^(0),"^",6),1:"Unknown")

                   SET IEN=IEN+1

                   SET ^TMP("PSOAL",$JOB,IEN,0)="Division: "_PSDIV_$EXTRACT("        ",$LENGTH(PSDIV)+1,8)_"  "

 +12               SET ^TMP("PSOAL",$JOB,IEN,0)=^TMP("PSOAL",$JOB,IEN,0)_"Dispensed: "_$SELECT($PIECE(P1,"^",19):$EXTRACT($PIECE(P1,"^",19),4,5)_"/"_$EXTRACT($PIECE(P1,"^",19),6,7)_"/"_$EXTRACT($PIECE(P1,"^",19),2,3),1:"")_"  "

 +13              SET RTS=$SELECT($PIECE(P1,"^",16):" Returned to Stock: "_$EXTRACT($PIECE(P1,"^",16),4,5)_"/"_$EXTRACT($PIECE(P1,"^",16),6,7)_"/"_$EXTRACT($PIECE(P1,"^",16),2,3),1:" Released: "_...

                   ... $SELECT($$RXRLDT^PSOBPSUT(DA,N):$$FMTE^XLFDT($$RXRLDT^PSOBPSUT(DA,N)\1,2),1:""))