Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSORXRPT.m

    r613 r623  
    1 PSORXRPT        ;BIR/SAB-reprint of a prescription label ;7:48 AM  31 Dec 2008
    2         ;;7.0;OUTPATIENT PHARMACY;**3,21,27,34,120,138,156,148,280,208**;DEC 1997;Build 41;WorldVistA 30-Jan-08
    3         ;
    4         ;Modified from FOIA VISTA,
    5         ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
    6         ;General Public License See attached copy of the License.
    7         ;
    8         ;This program is free software; you can redistribute it and/or modify
    9         ;it under the terms of the GNU General Public License as published by
    10         ;the Free Software Foundation; either version 2 of the License, or
    11         ;(at your option) any later version.
    12         ;
    13         ;This program is distributed in the hope that it will be useful,
    14         ;but WITHOUT ANY WARRANTY; without even the implied warranty of
    15         ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    16         ;GNU General Public License for more details.
    17         ;
    18         ;You should have received a copy of the GNU General Public License along
    19         ;with this program; if not, write to the Free Software Foundation, Inc.,
    20         ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    21         ;
    22         ;External reference to ^PSDRUG supported by DBIA 221
    23         ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
    24 BCK     I $G(PSOBEDT) W $C(7),$C(7) S VALMSG="Invalid Action at this time !",VALMBCK="" Q
    25         N PSODISP S PSORPLRX=$P(PSOLST(ORN),"^",2)
    26         I $$LMREJ^PSOREJU1(PSORPLRX,,.VALMSG,.VALMBCK) Q
    27         D PSOL^PSSLOCK(PSORPLRX) I '$G(PSOMSG) S VALMSG=$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order."),VALMBCK="" K PSOMSG Q
    28         I $G(POERR) K QFLG D  I $G(QFLG) D ULR G KILL
    29         .D FULL^VALM1 S X=$P(^PSRX($P(PSOLST(ORN),"^",2),0),"^"),Y=$P(PSOLST(ORN),"^",2)_"^"_X,Y(0)=$G(^PSRX($P(PSOLST(ORN),"^",2),0))
    30         .I $D(RXPR($P(PSOLST(ORN),"^",2))) S VALMBCK="",VALMSG="A Partial Rx has been requested!",QFLG=1 Q
    31         .I $D(RXRP($P(PSOLST(ORN),"^",2))) S VALMBCK="",VALMSG="A Reprint Label has been requested!",QFLG=1 Q
    32         .I $D(RXRS($P(PSOLST(ORN),"^",2))) S VALMBCK="",VALMSG="Rx is being pulled from suspense!",QFLG=1 Q
    33         .S RX=$P(PSOLST(ORN),"^",2) D VALID^PSORXRP1 S:$G(QFLG) VALMBCK="",VALMSG="A New Label has been requested already!"
    34         S (PPL,DA,RX)=+Y,PDA=Y(0),RXF=0,ZD(DA)=DT,REPRINT=1,STA=+$G(^PSRX(+Y,"STA"))
    35         ;WVERH ;begin p208
    36         ;
    37         S DIC="^VA(200,",DIC(0)="QEZ",X="AUTOFINISH,RX" ;vfah
    38         D ^DIC K DIC ;vfah
    39         S PSOZAF=+Y ;vfah
    40         I $P($G(^PSRX(RX,"OR1")),"^",5)=$G(PSOZAF) S VALMBCK="",VALMSG="This reprint option is not available for Autofinshed Rxs",QFLG=1 K PSOZAF D ULR,KILL Q  ;vfah
    41         ;WVEHR ;end p208
    42         ;
    43         I $P(^PSRX(RX,"STA"),"^")=14 S VALMBCK="",VALMSG="Cannot Reprint! Discontinued by Provider.",QFLG=1 D ULR,KILL Q
    44         I $P(^PSRX(RX,"STA"),"^")=15 S VALMBCK="",VALMSG="Cannot Reprint! Discontinued due to editing.",QFLG=1 D ULR,KILL Q
    45         I $P(^PSRX(RX,"STA"),"^")=16 S VALMBCK="",VALMSG="Cannot Reprint! Placed on HOLD by Provider.",QFLG=1 D ULR,KILL Q
    46         I DT>$P(^PSRX(RX,2),"^",6) D  G PAUSE
    47         .W !,$C(7),"Medication Expired on "_$E($P(^PSRX(RX,2),"^",6),4,5)_"-"_$E($P(^(2),"^",6),6,7)_"-"_$E($P(^(2),"^",6),2,3) I $P(^PSRX(DA,"STA"),"^")<11 S $P(^PSRX(DA,"STA"),"^")=11 D
    48         ..S COMM="Medication Expired on "_$E($P(^PSRX(RX,2),"^",6),4,5)_"-"_$E($P(^(2),"^",6),6,7)_"-"_$E($P(^(2),"^",6),2,3) D EN^PSOHLSN1(DA,"SC","ZE",COMM) K COMM
    49         S DFN=$P(PDA,"^",2) D DEM^VADPT I $P(VADM(6),"^",2)]"" D  G PAUSE
    50         .W $C(7),!!,$P(^DPT($P(PDA,"^",2),0),"^")_" Died "_$P(VADM(6),"^",2)_".",!
    51         .S $P(^PSRX(RX,"STA"),"^")=12,PCOM="Patient Expired "_$P(VADM(6),"^",2),ST="C" D EN^PSOHLSN1(RX,"OD","",PCOM,"A")
    52         .D ACT1,ULR,KILL
    53         S X=$O(^PS(52.5,"B",DA,0)) I X,'$G(^PS(52.5,X,"P")) W !,$C(7),"RX MAY NOT BE PRINTED using this option, use SUSPENSE FUNCTIONS Options." K X G PAUSE
    54         S PSX=0 F J=0:0 S J=$O(^PSRX(DA,1,J)) Q:'J  S PSX=J
    55         K X
    56         I $D(^PS(52.4,DA)) W !,"Prescription is Non-Verified",!! G PAUSE
    57         S DFN=$P(^PSRX(DA,0),"^",2) I $D(^PS(52.4,"AREF",DFN,DA)) W !,"Prescription is waiting for others to be verified",!! G PAUSE
    58         I $G(PSODIV),$D(^PSRX(DA,2)),+$P(^(2),"^",9),+$P(^(2),"^",9)'=PSOSITE S PSPOP=0,PSPRXN=DA D CHK1^PSOUTLA G:$G(POERR)&(PSPOP) PAUSE G:PSPOP PAUSE
    59         I STA=3 W !?3,"Prescription is on Hold" G PAUSE
    60         I STA=4 W !?3,"Prescription is Pending Due to Drug Interactions" G PAUSE
    61         I STA=12 W !?3,"Prescription is Discontinued" G PAUSE
    62         S COPIES=$S($P(PDA,"^",18)]"":$P(PDA,"^",18),1:1)
    63         K DIR S DIR("A")="Number of Copies? ",DIR("B")=COPIES,DIR(0)="N^1:99:0",DIR("?")="Enter the number of copies you want (1 to 99)"
    64         D ^DIR K DIR I $D(DIRUT) D ULR G KILL
    65         S COPIES=Y
    66         K DIR S DIR("A")="Print adhesive portion of label only? ",DIR(0)="Y",DIR("B")="No",DIR("?",1)="If entire label, including trailers are to print press RETURN for default."
    67         S DIR("?")="Else if only bottle and mailing labels are to print enter Y or YES." D ^DIR K DIR I $D(DUOUT) D ULR,KILL G PAUSE
    68         I $D(DIRUT) D ULR G KILL
    69         S SIDE=Y
    70         I $P(PSOPAR,"^",30),$$GET1^DIQ(59,PSOSITE_",",105,"I")=2.4 D
    71         .I $S($P(PSOPAR,"^",30)=3:1,$P(PSOPAR,"^",30)=4:1,1:0),'$$GET1^DIQ(50,$P(PDA,"^",6),28,"I") Q
    72         .K DIR,DIRUT S DIR("A")="Do you want to resend to Dispensing System Device",DIR(0)="Y",DIR("B")="No"
    73         .D ^DIR K DIR Q:$D(DIRUT)  S PSODISP=$S(Y:0,1:1)
    74         I $D(DIRUT) D ULR G KILL
    75         D ACT I $D(DIRUT) D ULR,KILL G PAUSE
    76         Q:$G(POERR)&($D(PCOM))  G PAUSE:$D(PCOM)
    77         F I=1,2,4,6,7,9,13,16 S P(I)=$P(PDA,"^",I)
    78         S P(6)=+P(6) I $D(^PSRX(DA,"TN")),^("TN")]"" S P(6)=^("TN")
    79         W !!,"Rx # "_P(1),?23,$E(P(13),4,5)_"/"_$E(P(13),6,7)_"/"_$E(P(13),2,3),!,$S($D(^DPT(+P(2),0)):$P(^(0),"^"),1:"Not on File"),?30,"#"_P(7),!
    80         I $P($G(^PSRX(DA,"SIG")),"^",2) S D=0 D  K D,FSIG
    81         .D FSIG^PSOUTLA("R",DA,75) F  S D=$O(FSIG(D)) W !,FSIG(D) Q:'$O(FSIG(D))
    82         E  D EN3^PSOUTLA1(DA,75) S D=0 F  S D=$O(BSIG(D)) W !,BSIG(D) Q:'$O(BSIG(D))
    83         K D,BSIG
    84         ;PSO*7*280 If trade name is used Stop the DRUG Lookup.
    85         W !!,$S($G(^PSRX(DA,"TN"))]"":P(6),(P(6)=+P(6))&$D(^PSDRUG(P(6),0)):$P(^(0),"^"),1:P(6)),! S PHYS=$S($D(^VA(200,+P(4),0)):$P(^(0),"^"),1:"Unknown") W PHYS K PHYS
    86         W ?25,$S($D(^VA(200,+P(16),0)):$P(^(0),"^"),1:"Unknown"),!,"# of Refills: "_$G(P(9))
    87         I $G(RX) S RXFL(RX)=0 F ZZZ=0:0 S ZZZ=$O(^PSRX(RX,1,ZZZ)) Q:'ZZZ  S RXFL(RX)=ZZZ
    88         K PSOELSE I '$G(POERR) S PSOELSE=1 D @$S($P($G(PSOPAR),"^",26):"^PSORXL",1:"Q^PSORXL")
    89         I '$G(PSOELSE) D
    90         .S RXRP($P(PSOLST(ORN),"^",2))=1_"^"_COPIES_"^"_SIDE
    91         .I $G(PSODISP)=1 S RXRP($P(PSOLST(ORN),"^",2),"RP")=1
    92         .I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=DA_"," Q
    93         .F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1  S PSOX2=PSOX1
    94         .I $L(PSORX("PSOL",PSOX2))+$L(DA)<220 S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_DA_","
    95         .E  S PSORX("PSOL",PSOX2+1)=DA_","
    96         K PCOMX,PSPOP,PPL,COPIES,SIDE,PCOM,IOP,PSL,PSNP,PSOELSE,ZZZ
    97 PAUSE   K RX,PPL,ZD(+$G(DA)),DA I $G(POERR) K DIR,DIRUT,DUOUT,DTOUT S DIR(0)="E",DIR("A",1)=" ",DIR("A")="Press Return to Continue" D ^DIR K DIR,DIRUT,DUOUT,DTOUT S VALMBCK="R"
    98         D ULR K PSORPLRX
    99         Q
    100         ;
    101 ACT     K DIR S DIR("A")="Comments: ",DIR(0)="FA^5:60",DIR("?")="5-60 characters input required for activity log." S:$G(PCOMX)]"" DIR("B")=$G(PCOMX)
    102         D ^DIR K DIR Q:$D(DIRUT)!($D(DIROUT))  S (PCOM,PCOMX)=X
    103         I '$D(PSOCLC) S PSOCLC=DUZ
    104 ACT1    S RXF=0 F J=0:0 S J=$O(^PSRX(DA,1,J)) Q:'J  S RXF=J S:J>5 RXF=J+1
    105         S IR=0 F J=0:0 S J=$O(^PSRX(DA,"A",J)) Q:'J  S IR=J
    106         S IR=IR+1,^PSRX(DA,"A",0)="^52.3DA^"_IR_"^"_IR
    107         D NOW^%DTC S ^PSRX(DA,"A",IR,0)=%_"^"_$S($G(ST)'="C":"W",1:"C")_"^"_DUZ_"^"_RXF_"^"_PCOM_$S($G(ST)'="C":" ("_COPIES_" COPIES)",1:""),PCOMX=PCOM K PC,IR,PS,PCOM,XX,%,%H,%I,RXF
    108         S:$P(^PSRX(DA,2),"^",15)&($G(ST)'="C") $P(^PSRX(DA,2),"^",14)=1
    109         Q
    110         ;
    111 KILL    K QFLG,%,DIR,DUOUT,DTOUT,DIROUT,DIRUT,PCOM,PCOMX,C,DA,DIC,I,J,JJJ,K,RX,RXF,X,Y,Z,DFN,P,PDA,PSPRXN,COPIES,SIDE,PPL,REPRINT,PSOMSG,PSORPLRX D KVA^VADPT Q
    112         ;
    113 ULR     ;
    114         I $G(PSORPLRX) D PSOUL^PSSLOCK(PSORPLRX)
    115         Q
     1PSORXRPT ;BIR/SAB-reprint of a prescription label ; 12/10/06 8:42pm
     2 ;;7.0;OUTPATIENT PHARMACY;**3,21,27,34,120,138,156,148,208**;DEC 1997;Build 39
     3 ; Modified from FOIA VISTA,
     4 ; Copyright (C) 2007 WorldVistA
     5 ;
     6 ; This program is free software; you can redistribute it and/or modify
     7 ; it under the terms of the GNU General Public License as published by
     8 ; the Free Software Foundation; either version 2 of the License, or
     9 ; (at your option) any later version.
     10 ;
     11 ; This program is distributed in the hope that it will be useful,
     12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     14 ; GNU General Public License for more details.
     15 ;
     16 ; You should have received a copy of the GNU General Public License
     17 ; along with this program; if not, write to the Free Software
     18 ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
     19 ;External reference to ^PSDRUG supported by DBIA 221
     20 ;External references PSOL and PSOUL^PSSLOCK supported by DBIA 2789
     21BCK I $G(PSOBEDT) W $C(7),$C(7) S VALMSG="Invalid Action at this time !",VALMBCK="" Q
     22 N PSODISP S PSORPLRX=$P(PSOLST(ORN),"^",2)
     23 I $$LMREJ^PSOREJU1(PSORPLRX,,.VALMSG,.VALMBCK) Q
     24 D PSOL^PSSLOCK(PSORPLRX) I '$G(PSOMSG) S VALMSG=$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order."),VALMBCK="" K PSOMSG Q
     25 I $G(POERR) K QFLG D  I $G(QFLG) D ULR G KILL
     26 .D FULL^VALM1 S X=$P(^PSRX($P(PSOLST(ORN),"^",2),0),"^"),Y=$P(PSOLST(ORN),"^",2)_"^"_X,Y(0)=$G(^PSRX($P(PSOLST(ORN),"^",2),0))
     27 .I $D(RXPR($P(PSOLST(ORN),"^",2))) S VALMBCK="",VALMSG="A Partial Rx has been requested!",QFLG=1 Q
     28 .I $D(RXRP($P(PSOLST(ORN),"^",2))) S VALMBCK="",VALMSG="A Reprint Label has been requested!",QFLG=1 Q
     29 .I $D(RXRS($P(PSOLST(ORN),"^",2))) S VALMBCK="",VALMSG="Rx is being pulled from suspense!",QFLG=1 Q
     30 .S RX=$P(PSOLST(ORN),"^",2) D VALID^PSORXRP1 S:$G(QFLG) VALMBCK="",VALMSG="A New Label has been requested already!"
     31 S (PPL,DA,RX)=+Y,PDA=Y(0),RXF=0,ZD(DA)=DT,REPRINT=1,STA=+$G(^PSRX(+Y,"STA"))
     32 ;
     33 S DIC="^VA(200,",DIC(0)="QEZ",X="AUTOFINISH,RX" ;vfah
     34 D ^DIC K DIC ;vfah
     35 S PSOZAF=+Y ;vfah
     36 I $P($G(^PSRX(RX,"OR1")),"^",5)=$G(PSOZAF) S VALMBCK="",VALMSG="This reprint option is not available for Autofinshed Rxs",QFLG=1 K PSOZAF D ULR,KILL Q  ;vfah
     37 ;
     38 I $P(^PSRX(RX,"STA"),"^")=14 S VALMBCK="",VALMSG="Cannot Reprint! Discontinued by Provider.",QFLG=1 D ULR,KILL Q
     39 I $P(^PSRX(RX,"STA"),"^")=15 S VALMBCK="",VALMSG="Cannot Reprint! Discontinued due to editing.",QFLG=1 D ULR,KILL Q
     40 I $P(^PSRX(RX,"STA"),"^")=16 S VALMBCK="",VALMSG="Cannot Reprint! Placed on HOLD by Provider.",QFLG=1 D ULR,KILL Q
     41 I DT>$P(^PSRX(RX,2),"^",6) D  G PAUSE
     42 .W !,$C(7),"Medication Expired on "_$E($P(^PSRX(RX,2),"^",6),4,5)_"-"_$E($P(^(2),"^",6),6,7)_"-"_$E($P(^(2),"^",6),2,3) I $P(^PSRX(DA,"STA"),"^")<11 S $P(^PSRX(DA,"STA"),"^")=11 D
     43 ..S COMM="Medication Expired on "_$E($P(^PSRX(RX,2),"^",6),4,5)_"-"_$E($P(^(2),"^",6),6,7)_"-"_$E($P(^(2),"^",6),2,3) D EN^PSOHLSN1(DA,"SC","ZE",COMM) K COMM
     44 S DFN=$P(PDA,"^",2) D DEM^VADPT I $P(VADM(6),"^",2)]"" D  G PAUSE
     45 .W $C(7),!!,$P(^DPT($P(PDA,"^",2),0),"^")_" Died "_$P(VADM(6),"^",2)_".",!
     46 .S $P(^PSRX(RX,"STA"),"^")=12,PCOM="Patient Expired "_$P(VADM(6),"^",2),ST="C" D EN^PSOHLSN1(RX,"OD","",PCOM,"A")
     47 .D ACT1,ULR,KILL
     48 S X=$O(^PS(52.5,"B",DA,0)) I X,'$G(^PS(52.5,X,"P")) W !,$C(7),"RX MAY NOT BE PRINTED using this option, use SUSPENSE FUNCTIONS Options." K X G PAUSE
     49 S PSX=0 F J=0:0 S J=$O(^PSRX(DA,1,J)) Q:'J  S PSX=J
     50 K X
     51 I $D(^PS(52.4,DA)) W !,"Prescription is Non-Verified",!! G PAUSE
     52 S DFN=$P(^PSRX(DA,0),"^",2) I $D(^PS(52.4,"AREF",DFN,DA)) W !,"Prescription is waiting for others to be verified",!! G PAUSE
     53 I $G(PSODIV),$D(^PSRX(DA,2)),+$P(^(2),"^",9),+$P(^(2),"^",9)'=PSOSITE S PSPOP=0,PSPRXN=DA D CHK1^PSOUTLA G:$G(POERR)&(PSPOP) PAUSE G:PSPOP PAUSE
     54 I STA=3 W !?3,"Prescription is on Hold" G PAUSE
     55 I STA=4 W !?3,"Prescription is Pending Due to Drug Interactions" G PAUSE
     56 I STA=12 W !?3,"Prescription is Discontinued" G PAUSE
     57 S COPIES=$S($P(PDA,"^",18)]"":$P(PDA,"^",18),1:1)
     58 K DIR S DIR("A")="Number of Copies? ",DIR("B")=COPIES,DIR(0)="N^1:99:0",DIR("?")="Enter the number of copies you want (1 to 99)"
     59 D ^DIR K DIR I $D(DIRUT) D ULR G KILL
     60 S COPIES=Y
     61 K DIR S DIR("A")="Print adhesive portion of label only? ",DIR(0)="Y",DIR("B")="No",DIR("?",1)="If entire label, including trailers are to print press RETURN for default."
     62 S DIR("?")="Else if only bottle and mailing labels are to print enter Y or YES." D ^DIR K DIR I $D(DUOUT) D ULR,KILL G PAUSE
     63 I $D(DIRUT) D ULR G KILL
     64 S SIDE=Y
     65 I $P(PSOPAR,"^",30),$$GET1^DIQ(59,PSOSITE_",",105,"I")=2.4 D
     66 .I $S($P(PSOPAR,"^",30)=3:1,$P(PSOPAR,"^",30)=4:1,1:0),'$$GET1^DIQ(50,$P(PDA,"^",6),28,"I") Q
     67 .K DIR,DIRUT S DIR("A")="Do you want to resend to Dispensing System Device",DIR(0)="Y",DIR("B")="No"
     68 .D ^DIR K DIR Q:$D(DIRUT)  S PSODISP=$S(Y:0,1:1)
     69 I $D(DIRUT) D ULR G KILL
     70 D ACT I $D(DIRUT) D ULR,KILL G PAUSE
     71 Q:$G(POERR)&($D(PCOM))  G PAUSE:$D(PCOM)
     72 F I=1,2,4,6,7,9,13,16 S P(I)=$P(PDA,"^",I)
     73 S P(6)=+P(6) I $D(^PSRX(DA,"TN")),^("TN")]"" S P(6)=^("TN")
     74 W !!,"Rx # "_P(1),?23,$E(P(13),4,5)_"/"_$E(P(13),6,7)_"/"_$E(P(13),2,3),!,$S($D(^DPT(+P(2),0)):$P(^(0),"^"),1:"Not on File"),?30,"#"_P(7),!
     75 I $P($G(^PSRX(DA,"SIG")),"^",2) S D=0 D  K D,FSIG
     76 .D FSIG^PSOUTLA("R",DA,75) F  S D=$O(FSIG(D)) W !,FSIG(D) Q:'$O(FSIG(D))
     77 E  D EN3^PSOUTLA1(DA,75) S D=0 F  S D=$O(BSIG(D)) W !,BSIG(D) Q:'$O(BSIG(D))
     78 K D,BSIG
     79 W !!,$S((P(6)=+P(6))&$D(^PSDRUG(P(6),0)):$P(^(0),"^"),1:P(6)),! S PHYS=$S($D(^VA(200,+P(4),0)):$P(^(0),"^"),1:"Unknown") W PHYS K PHYS
     80 W ?25,$S($D(^VA(200,+P(16),0)):$P(^(0),"^"),1:"Unknown"),!,"# of Refills: "_$G(P(9))
     81 I $G(RX) S RXFL(RX)=0 F ZZZ=0:0 S ZZZ=$O(^PSRX(RX,1,ZZZ)) Q:'ZZZ  S RXFL(RX)=ZZZ
     82 K PSOELSE I '$G(POERR) S PSOELSE=1 D @$S($P($G(PSOPAR),"^",26):"^PSORXL",1:"Q^PSORXL")
     83 I '$G(PSOELSE) D
     84 .S RXRP($P(PSOLST(ORN),"^",2))=1_"^"_COPIES_"^"_SIDE
     85 .I $G(PSODISP)=1 S RXRP($P(PSOLST(ORN),"^",2),"RP")=1
     86 .I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=DA_"," Q
     87 .F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1  S PSOX2=PSOX1
     88 .I $L(PSORX("PSOL",PSOX2))+$L(DA)<220 S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_DA_","
     89 .E  S PSORX("PSOL",PSOX2+1)=DA_","
     90 K PCOMX,PSPOP,PPL,COPIES,SIDE,PCOM,IOP,PSL,PSNP,PSOELSE,ZZZ
     91PAUSE K RX,PPL,ZD(+$G(DA)),DA I $G(POERR) K DIR,DIRUT,DUOUT,DTOUT S DIR(0)="E",DIR("A",1)=" ",DIR("A")="Press Return to Continue" D ^DIR K DIR,DIRUT,DUOUT,DTOUT S VALMBCK="R"
     92 D ULR K PSORPLRX
     93 Q
     94 ;
     95ACT K DIR S DIR("A")="Comments: ",DIR(0)="FA^5:60",DIR("?")="5-60 characters input required for activity log." S:$G(PCOMX)]"" DIR("B")=$G(PCOMX)
     96 D ^DIR K DIR Q:$D(DIRUT)!($D(DIROUT))  S (PCOM,PCOMX)=X
     97 I '$D(PSOCLC) S PSOCLC=DUZ
     98ACT1 S RXF=0 F J=0:0 S J=$O(^PSRX(DA,1,J)) Q:'J  S RXF=J S:J>5 RXF=J+1
     99 S IR=0 F J=0:0 S J=$O(^PSRX(DA,"A",J)) Q:'J  S IR=J
     100 S IR=IR+1,^PSRX(DA,"A",0)="^52.3DA^"_IR_"^"_IR
     101 D NOW^%DTC S ^PSRX(DA,"A",IR,0)=%_"^"_$S($G(ST)'="C":"W",1:"C")_"^"_DUZ_"^"_RXF_"^"_PCOM_$S($G(ST)'="C":" ("_COPIES_" COPIES)",1:""),PCOMX=PCOM K PC,IR,PS,PCOM,XX,%,%H,%I,RXF
     102 S:$P(^PSRX(DA,2),"^",15)&($G(ST)'="C") $P(^PSRX(DA,2),"^",14)=1
     103 Q
     104 ;
     105KILL K QFLG,%,DIR,DUOUT,DTOUT,DIROUT,DIRUT,PCOM,PCOMX,C,DA,DIC,I,J,JJJ,K,RX,RXF,X,Y,Z,DFN,P,PDA,PSPRXN,COPIES,SIDE,PPL,REPRINT,PSOMSG,PSORPLRX D KVA^VADPT Q
     106 ;
     107ULR ;
     108 I $G(PSORPLRX) D PSOUL^PSSLOCK(PSORPLRX)
     109 Q
Note: See TracChangeset for help on using the changeset viewer.