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/PSOLBL1.m

    r613 r623  
    1 PSOLBL1 ;BHAM ISC/SAB - PRINTS LABEL ;1/20/93 14:25
    2         ;;7.0;OUTPATIENT PHARMACY;**107,110,225**;DEC 1997;Build 29
    3 START   S COPIES=COPIES-1
    4         W $C(13) S $X=0 W "VA (119)",?10,$E(DT,4,5),"/",$E(DT,6,7),"/",$E(DT,2,3) W:('SIDE)&(PRTFL) ?40,"PLEASE REFER ONLY TO '",$S(REF:"1. REFILL REQUEST",1:"2. RENEWAL ORDER"),"'" W:+$G(RXP) ?100,"(PARTIAL)" W:$D(REPRINT) ?110,"(REPRINT)"
    5         W !,$P(PS,"^",2) W:('SIDE)&(PRTFL) ?40,"INSTRUCTION ON REVERSE SIDE OF THIS FORM" W:'SIDE ?102,"(Filled at ",$P(PS2,"^",2),")"
    6         W !,$P(PS,"^",7),", ",STATE,"  ",$P(PS,"^",5) W:'SIDE ?83,"*** ",$P(PS2,"^")," ***"
    7         W !,?22,$S(MW["C":"CERTIFIED MAIL",1:"") W:'SIDE ?38,SSNP,?69,"RX: ",RXN
    8         W !,?2,PNM W:'SIDE ?38,PNM,?64,"EXPIRES: ",EXDT W:('SIDE)&(PRTFL) ?83,"INDICATE ANY ADDRESS CHANGES"
    9         W !,?2,$S($D(PSMP(1)):PSMP(1),1:VAPA(1)) W:'SIDE ?38,$E(VAPA(1),1,25),?64,"REFILLS: ",REF ;W:('SIDE)&(PRTFL) ?83,LINE
    10         W:('SIDE)&(PRTFL) ?83,"_____PERM.   _____TEMP." W:'PRTFL ?83,"* A 'NEW' RX IS REQUIRED.        *"
    11         S ADDR(3)=VAPA(4)_", "_$P($G(^DIC(5,+$P(VAPA(5),"^"),0)),"^",2)_"  "_VAPA(6),ADDR(2)="" S:VAPA(2)]"" ADDR(2)=VAPA(2)_" "_VAPA(3)
    12         I ADDR(2)="" S ADDR(2)=ADDR(3),ADDR(3)=""
    13         S ADDR(5)=$E(VAPA(4),1,13)_", "_$P($G(^DIC(5,+$P(VAPA(5),"^"),0)),"^",2)_"  "_VAPA(6)
    14         W !,?2,$S($D(PSMP(2)):PSMP(2),$D(PSMP(1)):"",1:$E(ADDR(2),1,35)) W:'SIDE ?38,$S($G(ADDR(3))="":ADDR(5),1:$E(ADDR(2),1,24)),?62,$S(RFLMSG]"":"*",1:" "),"LST FILL: "
    15         W:'SIDE $G(PSOLASTF)
    16         I 'SIDE W:PRTFL ?83,"ADDRESS: ",$E(LINE,1,23) W:'PRTFL ?83,"********** PLEASE NOTE ***********"
    17         W !,?2,$S($D(PSMP(3)):PSMP(3),$D(PSMP(1)):"",1:ADDR(3)) I 'SIDE W ?38,$S(ADDR(3)'="":ADDR(5),1:""),?64,"ROUTING: ",$S(MW="REGULAR":"MAIL",1:MW) W:PRTFL ?83,"CITY/STATE/ZIP: ",$E(LINE,1,16) W:'PRTFL ?83,"* THIS RX CAN NOT BE 'RENEWED'.  *"
    18         ;NEW LABEL WHITE SPACE
    19         I +$G(PSOBARS),'SIDE,$P(PSOPAR,"^",19)'=1 S X="S",X2=PSOINST_"-"_RX W !,?40 S X1=$X W @PSOBAR1,X2,@PSOBAR0,$C(13),!,$S($G(PS55)=2:"***DO NOT MAIL***",1:"**CRITICAL MEDICAL SHIPMENT**"),!
    20         E  F NLWS=1:1:6 W ! W:NLWS=5 $S($G(PS55)=2:"***DO NOT MAIL***",1:"**CRITICAL MEDICAL SHIPMENT**")
    21         W !,?8,"VA Medical Center" I 'SIDE W ?38,INT(1)
    22         W !,$P(PS,"^"),"  ",$P(PS,"^",3),"-",$P(PS,"^",4) W:'SIDE ?38,INT(2) I 'SIDE W:PRTFL ?83 W:'PRTFL ?83,"* PLEASE CONTACT YOUR PHYSICIAN. *"
    23         W !,?4,RXN,?15,$E(DATE,4,5),"/",$E(DATE,6,7),"/",$E(DATE,2,3),"   (",RXF+1," OF ",1+$P(RXY,"^",9),")" I 'SIDE W ?38,INT(3) W:(PRTFL)&('REF) ?83,"***** FOR PHYSICIAN USE ONLY *****" W:'PRTFL ?83,"**********************************"
    24         W !,PNM,?29,"#",$P(RXY,"^",7)
    25         W:'SIDE ?38,"CAP: ",$S(PSCAP:"**NON-SFTY**",1:"SAFETY")," WARN:",WARN,?68,$E(DATE,4,5),"/",$E(DATE,6,7),"/",$E(DATE,2,3)," " S I1=$P($H,",",2)\60 W:'SIDE I1\60,":",(I1#60\10)_(I1#10) W:('SIDE)&(PRTFL) ?83,"SIGNATURE : ",$E(LINE,1,20)
    26 SIG     F DR=1:1:$S(SGC<5:4,1:6) D SIG1
    27         I SGC>4 F I=1:1:22 W ! I I>22-SGC S DR=DR+1,X=$S($D(SGY(DR)):SGY(DR),1:"") W X W:'SIDE ?38,X
    28         ;I SGC>4 F I=1:1:$S($P($G(PSOPAR),"^",10):22,1:16) W ! I I>($S($P($G(PSOPAR),"^",10):28,1:22)-SGC) S DR=DR+1,X=$S($D(SGY(DR)):SGY(DR),1:"") W X W:'SIDE ?38,X
    29         W !?3,$E(PHYS,1,14),?25,"(",$P(RXY,"^",16),"/",$S($D(VRPH):VRPH,1:" "),")" W:'SIDE ?38,DRUG,?38+$L(DRUG)," (QTY:",$P(RXY,"^",7)," DAYS:",$P(RXY,"^",8)," FILL: ",RXF+1," OF ",1+$P(RXY,"^",9)," ISD:",ISD,")"
    30         W !,DRUG W:'SIDE ?38,PHYS,?62,RFLMSG,?100,PATST,"  ",PSCLN
    31         I $D(PSOBARS),PSOBARS W $C(13),# S $X=0
    32         E  W !
    33         I COPIES>0 S SIDE=1 G START
    34         ;STORE LABEL PRINT NODE
    35         D NOW^%DTC S NOW=% K %,%H,%I S RXF=0 F I=0:0 S I=$O(^PSRX(RX,1,I)) Q:'I  S RXF=I
    36         S IR=0 F FDA=0:0 S FDA=$O(^PSRX(RX,"L",FDA)) Q:'FDA  S IR=FDA
    37         S IR=IR+1,^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR
    38         S ^PSRX(RX,"L",IR,0)=NOW_"^"_$S($G(RXP):99-RXPI,1:RXF)_"^"_$S($G(PCOMX)]"":$G(PCOMX),1:"From RX number "_$P(^PSRX(RX,0),"^"))_$S($G(RXP):" (Partial)",1:"")_$S($D(REPRINT):" (Reprint)",1:"")_"^"_PDUZ
    39         S ^PSRX(RX,"TYPE")=0 K RXF,IR,FDA,NOW,I
    40         I '$D(PSSPND),$P(PSOPAR,"^",18) D CHCK2^PSOTRLBL
    41 END     K PSCLN,%DT,ADDR,DATE,DEA,DR,DR1,DRX,DRUG,FDT,SGY,RXY,RXZ,RYY,RFLMSG,RFL,%H,COPIES,DOB,DRUG,LIM,LMI,LINE,PS,PS1,PS2,INT,ISD,I1,MW,MAIL,STATE,SIDE,SSNP,SS,ST,ST1,PATST,PRTFL,PHYS,PNM,S,SL,SGC,PSMP,PSI,PSJ,VRPH,REPRINT,PS55,PS55X Q
    42         Q
    43         ;
    44 SIG1    S X=$S($D(SGY(DR)):SGY(DR),1:"") W !,X
    45         I 'SIDE W ?38,X I PRTFL W ?83 W:DR=1 ?83,$S('REF:"PRINT NAME: "_$E(LINE,1,25),1:"") W:DR=2 "DATE: ",$E(LINE,1,10) W:(DR=2)&('REF) " DEA# ",$E(LINE,1,6) W:(DR=3)&('REF) "Refills: 0 1 2 3 4 5 6 7 8 9 10 11"
    46         Q
    47         ;
    48 OSET    I $G(RXFL(RX))']""!($G(RXFL(RX))=0) D  Q
    49         .S TECH=$P($G(^VA(200,+$P(^PSRX(RX,0),"^",16),0)),"^"),QTY=$P(^PSRX(RX,0),"^",7),PHYS=$S($D(^VA(200,+$P(^PSRX(RX,0),"^",4),0)):$P(^(0),"^"),1:"UKN") D 6^VADPT,PID^VADPT S SSNPN=$E($G(VA("PID")),5,12)
    50         .S DAYS=$P(^PSRX(RX,0),"^",8),MFG="________",LOT="________"
    51         I '$D(^PSRX(RX,1,RXFL(RX),0)) K RXFL(RX) Q
    52         S TECH=$S($D(^VA(200,+$P(^PSRX(RX,1,RXFL(RX),0),"^",7),0)):$P(^(0),"^"),1:"UNKNOWN")
    53         S QTY=$P(^PSRX(RX,1,RXFL(RX),0),"^",4),PHYS=$S($D(^VA(200,+$P(^PSRX(RX,1,RXFL(RX),0),"^",17),0)):$P(^(0),"^"),$D(^VA(200,+$P(^PSRX(RX,0),"^",4),0)):$P(^(0),"^"),1:"UNKNOWN") D 6^VADPT,PID^VADPT S SSNPN=$E($G(VA("PID")),5,12)
    54         S DAYS=$P(^PSRX(RX,1,RXFL(RX),0),"^",10),LOT="________",MFG="________"
    55         Q
     1PSOLBL1 ;BHAM ISC/SAB - PRINTS LABEL ;1/20/93 14:25
     2 ;;7.0;OUTPATIENT PHARMACY;**107,110**;DEC 1997
     3START S COPIES=COPIES-1
     4 W $C(13) S $X=0 W "VA (119)",?10,$E(DT,4,5),"/",$E(DT,6,7),"/",$E(DT,2,3) W:('SIDE)&(PRTFL) ?40,"PLEASE REFER ONLY TO '",$S(REF:"1. REFILL REQUEST",1:"2. RENEWAL ORDER"),"'" W:+$G(RXP) ?100,"(PARTIAL)" W:$D(REPRINT) ?110,"(REPRINT)"
     5 W !,$P(PS,"^",2) W:('SIDE)&(PRTFL) ?40,"INSTRUCTION ON REVERSE SIDE OF THIS FORM" W:'SIDE ?102,"(Filled at ",$P(PS2,"^",2),")"
     6 W !,$P(PS,"^",7),", ",STATE,"  ",$P(PS,"^",5) W:'SIDE ?83,"*** ",$P(PS2,"^")," ***"
     7 W !,?22,$S(MW["C":"CERTIFIED MAIL",1:"") W:'SIDE ?38,SSNP,?69,"RX: ",RXN
     8 W !,?2,PNM W:'SIDE ?38,PNM,?64,"EXPIRES: ",EXDT W:('SIDE)&(PRTFL) ?83,"INDICATE ANY ADDRESS CHANGES"
     9 W !,?2,$S($D(PSMP(1)):PSMP(1),1:VAPA(1)) W:'SIDE ?38,$E(VAPA(1),1,25),?64,"REFILLS: ",REF ;W:('SIDE)&(PRTFL) ?83,LINE
     10 W:('SIDE)&(PRTFL) ?83,"_____PERM.   _____TEMP." W:'PRTFL ?83,"* A 'NEW' RX IS REQUIRED.        *"
     11 S ADDR(3)=VAPA(4)_", "_$P($G(^DIC(5,+$P(VAPA(5),"^"),0)),"^",2)_"  "_VAPA(6),ADDR(2)="" S:VAPA(2)]"" ADDR(2)=VAPA(2)_" "_VAPA(3)
     12 I ADDR(2)="" S ADDR(2)=ADDR(3),ADDR(3)=""
     13 S ADDR(5)=$E(VAPA(4),1,13)_", "_$P($G(^DIC(5,+$P(VAPA(5),"^"),0)),"^",2)_"  "_VAPA(6)
     14 W !,?2,$S($D(PSMP(2)):PSMP(2),$D(PSMP(1)):"",1:$E(ADDR(2),1,35)) W:'SIDE ?38,$S($G(ADDR(3))="":ADDR(5),1:$E(ADDR(2),1,24)),?62,$S(RFLMSG]"":"*",1:" "),"LST FILL: "
     15 W:'SIDE $G(PSOLASTF)
     16 I 'SIDE W:PRTFL ?83,"ADDRESS: ",$E(LINE,1,23) W:'PRTFL ?83,"********** PLEASE NOTE ***********"
     17 W !,?2,$S($D(PSMP(3)):PSMP(3),$D(PSMP(1)):"",1:ADDR(3)) I 'SIDE W ?38,$S(ADDR(3)'="":ADDR(5),1:""),?64,"ROUTING: ",$S(MW="REGULAR":"MAIL",1:MW) W:PRTFL ?83,"CITY/STATE/ZIP: ",$E(LINE,1,16) W:'PRTFL ?83,"* THIS RX CAN NOT BE 'RENEWED'.  *"
     18 ;NEW LABEL WHITE SPACE
     19 I +$G(PSOBARS),'SIDE,$P(PSOPAR,"^",19)'=1 S X="S",X2=PSOINST_"-"_RX W !,?40 S X1=$X W @PSOBAR1,X2,@PSOBAR0,$C(13),!,$S($G(PS55)=2:"***DO NOT MAIL***",1:"**CRITICAL MEDICAL SHIPMENT**"),!
     20 E  F NLWS=1:1:6 W ! W:NLWS=5 $S($G(PS55)=2:"***DO NOT MAIL***",1:"**CRITICAL MEDICAL SHIPMENT**")
     21 W !,?8,"VA Medical Center" I 'SIDE W ?38,INT(1)
     22 W !,$P(PS,"^"),"  ",$P(PS,"^",3),"-",$P(PS,"^",4) W:'SIDE ?38,INT(2) I 'SIDE W:PRTFL ?83 W:'PRTFL ?83,"* PLEASE CONTACT YOUR PHYSICIAN. *"
     23 W !,?4,RXN,?15,$E(DATE,4,5),"/",$E(DATE,6,7),"/",$E(DATE,2,3),"   (",RXF+1," OF ",1+$P(RXY,"^",9),")" I 'SIDE W ?38,INT(3) W:(PRTFL)&('REF) ?83,"***** FOR PHYSICIAN USE ONLY *****" W:'PRTFL ?83,"**********************************"
     24 W !,PNM,?29,"#",$P(RXY,"^",7)
     25 W:'SIDE ?38,"CAP: ",$S(PSCAP:"**NON-SFTY**",1:"SAFETY")," WARN:",WARN,?68,$E(DATE,4,5),"/",$E(DATE,6,7),"/",$E(DATE,2,3)," " S I1=$P($H,",",2)\60 W:'SIDE I1\60,":",(I1#60\10)_(I1#10) W:('SIDE)&(PRTFL) ?83,"SIGNATURE : ",$E(LINE,1,20)
     26SIG F DR=1:1:$S(SGC<5:4,1:6) D SIG1
     27 I SGC>4 F I=1:1:22 W ! I I>22-SGC S DR=DR+1,X=$S($D(SGY(DR)):SGY(DR),1:"") W X W:'SIDE ?38,X
     28 ;I SGC>4 F I=1:1:$S($P($G(PSOPAR),"^",10):22,1:16) W ! I I>($S($P($G(PSOPAR),"^",10):28,1:22)-SGC) S DR=DR+1,X=$S($D(SGY(DR)):SGY(DR),1:"") W X W:'SIDE ?38,X
     29 W !?3,$E(PHYS,1,14),?25,"(",$P(RXY,"^",16),"/",$S($D(VRPH):VRPH,1:" "),")" W:'SIDE ?38,DRUG,?38+$L(DRUG)," (QTY:",$P(RXY,"^",7)," DAYS:",$P(RXY,"^",8)," FILL: ",RXF+1," OF ",1+$P(RXY,"^",9)," ISD:",ISD,")"
     30 W !,DRUG W:'SIDE ?38,PHYS,?62,RFLMSG,?100,PATST,"  ",PSCLN
     31 I $D(PSOBARS),PSOBARS W $C(13),# S $X=0
     32 E  W !
     33 I COPIES>0 S SIDE=1 G START
     34 ;STORE LABEL PRINT NODE
     35 D NOW^%DTC S NOW=% K %,%H,%I S RXF=0 F I=0:0 S I=$O(^PSRX(RX,1,I)) Q:'I  S RXF=I
     36 S IR=0 F FDA=0:0 S FDA=$O(^PSRX(RX,"L",FDA)) Q:'FDA  S IR=FDA
     37 S IR=IR+1,^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR
     38 S ^PSRX(RX,"L",IR,0)=NOW_"^"_$S($G(RXP):99-RXPI,1:RXF)_"^"_$S($G(PCOMX)]"":$G(PCOMX),1:"From RX number "_$P(^PSRX(RX,0),"^"))_$S($G(RXP):" (Partial)",1:"")_$S($D(REPRINT):" (Reprint)",1:"")_"^"_PDUZ
     39 S ^PSRX(RX,"TYPE")=0 K RXF,IR,FDA,NOW,I
     40 I '$D(PSSPND),$P(PSOPAR,"^",18) D CHCK2^PSOTRLBL
     41END K PSCLN,%DT,ADDR,DATE,DEA,DR,DR1,DRX,DRUG,FDT,SGY,RXY,RXZ,RYY,RFLMSG,RFL,%H,COPIES,DOB,DRUG,LIM,LMI,LINE,PS,PS1,PS2,INT,ISD,I1,MW,MAIL,STATE,SIDE,SSNP,SS,ST,ST1,PATST,PRTFL,PHYS,PNM,S,SL,SGC,PSMP,PSI,PSJ,VRPH,REPRINT,PS55,PS55X Q
     42 Q
     43 ;
     44SIG1 S X=$S($D(SGY(DR)):SGY(DR),1:"") W !,X
     45 I 'SIDE W ?38,X I PRTFL W ?83 W:DR=1 ?83,$S('REF:"PRINT NAME: "_$E(LINE,1,25),1:"") W:DR=2 "DATE: ",$E(LINE,1,10) W:(DR=2)&('REF) " DEA# ",$E(LINE,1,6) W:(DR=3)&('REF) "Refills: 0 1 2 3 4 5 6 7 8 9 10 11"
Note: See TracChangeset for help on using the changeset viewer.