source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOLLL4.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1PSOLLL4 ;BHAM/JLC - LASER LABELS PRINT PMI ;12/13/02
2 ;;7.0;OUTPATIENT PHARMACY;**120,135,161**;DEC 1997
3 ;
4 ;Reference to PSNPPIO supported by DBIA 3794
5 ;
6 S FLAG=$$EN^PSNPPIO(+$P(RXY,"^",6),.MSG)
7EN I $G(PSOIO("PMII"))]"" X PSOIO("PMII")
8 I '$G(PMIM) D MOREWARN
9 S T=PNM_" Rx#: "_RXN_" "_DRUG D PRINT(T,0) S PSOY=PSOY+PSOYI-25
10 S CONT=0 I PMIM S CONT=1 D PRINT(PMIF("T"),PMIF("H")) G CONT
11 I 'FLAG D PRINT(MSG) Q
12 S T=^TMP($J,"PSNPMI",0)_": "_$G(^TMP($J,"PSNPMI","F",1,0)) D PRINT(T,1) S PSOY=PSOY+PSOYI-25
13 S T=$G(^TMP($J,"PSNPMI","C",1,0)) I T]"" D PRINT(T,1) S PSOY=PSOY+PSOYI-25
14CONT S XFONT=$E(PSOFONT,2,99),(CNT,OUT,PMIM)=0
15 K A F A="W","U","H","S","M","P","I","O","N","D","R" S CNT=CNT+1,A(CNT)=A
16 F J=PMIF("A"):1 Q:$G(A(J))="" S A=A(J) I $D(^TMP($J,"PSNPMI",A,1,0)) S HDR=$S(PMIF("A")=1:1,PMIF("B")=1:1,J=PMIF("A"):0,1:1),LENGTH=0,PTEXT="" D Q:OUT S PSOY=PSOY+PSOYI-25
17 . F B=PMIF("B"):1 Q:'$D(^TMP($J,"PSNPMI",A,B,0)) S TEXT=^(0) D Q:OUT
18 .. F I=1:1 Q:$E(TEXT,I)'=" " S TEXT=$E(TEXT,2,255)
19 .. F I=PMIF("I"):1:$L(TEXT," ") D STRT^PSOLLU1("FULL",$P(TEXT," ",I)_" ",.L) D Q:OUT
20 ... I LENGTH+L(XFONT)<8.1 S PTEXT=PTEXT_$P(TEXT," ",I)_" ",LENGTH=LENGTH+L(XFONT) Q
21 ... S LENGTH=0,I=I-1
22 ... I HDR D Q
23 .... I PSOY>PSOYM S PMIF("A")=J,PMIF("I")=I+1,PMIF("B")=B,OUT=1,PMIM=1
24 .... D PRINT(PTEXT,1) S PTEXT="",HDR=0
25 ... I PSOY>(PSOYM+25) S PMIF("A")=J,PMIF("I")=I+1,PMIF("B")=B,OUT=1,PMIM=1 Q
26 ... D PRINT(PTEXT,0) S PTEXT=""
27 .. I 'PMIM F I="I","B" S PMIF(I)=1
28 . I 'PMIM S PMIF("B")=1
29 . I OUT S PMIF("T")=PTEXT,PMIF("H")=HDR
30 . Q:OUT I HDR,PTEXT[":" D Q
31 .. I PSOY>PSOYM S PMIF("A")=J,PMIF("I")=I+1,PMIF("B")=B,OUT=1,PMIM=1,PMIF("T")=PTEXT,PMIF("H")=HDR Q
32 .. I PTEXT]"" D PRINT(PTEXT,1)
33 . I PTEXT]"",PSOY>PSOYM S PMIF("A")=J,PMIF("I")=I+1,PMIF("B")=B,OUT=1,PMIM=1,PMIF("T")=PTEXT,PMIF("H")=HDR Q
34 . I PTEXT]"" D PRINT(PTEXT,0)
35 Q
36PRINT(T,HDR) ;
37 ; Input: T - text to be printed
38 ; HDR - 0-no / 1-yes
39 ;
40 S HDR=+$G(HDR)
41 I $G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
42 I $G(PSOIO("ST"))]"" X PSOIO("ST")
43 I HDR,$G(PSOIO(PSOFONT_"B"))]"" X PSOIO(PSOFONT_"B")
44 I HDR D G PRINT2
45 . W $P(T,":"),":"
46 . I $G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
47 . W $P(T,":",2,99)
48 W T
49PRINT2 I $G(PSOIO("ET"))]"" X PSOIO("ET")
50 W ! Q
51 ;
52MOREWARN ; SEE ID MORE THAN 5 WARNINGS AND PRINT REMAINDER, IF SO
53 N LEN,LEN2,I,J,PSOWARN,NEWWARN,PRE
54 S LEN=$L($G(WARN),",") I LEN<6 Q
55 S NEWWARN=$P(WARN,",",6,99)
56 S T="Additional Warning Labels:" D PRINT(T)
57 F I=1:1:$L(NEWWARN,",") S PSOWARN=$P(NEWWARN,",",I) D
58 .S PRE=PSOWARN_": ",LEN2=$L(PRE)
59 .S TEXT=$$WTEXT^PSSWRNA(PSOWARN,PSOLAN) I TEXT'="" D
60 ..I $L(TEXT)<100 S T=PRE_TEXT D PRINT(T) Q
61 ..S PTEXT="" F J=1:1:$L(TEXT," ") S PTEXT=PTEXT_$P(TEXT," ",J)_" " D
62 ...I $L(PTEXT)>90 D
63 ....S T=PRE_PTEXT D PRINT(T) S PRE=$E(" ",1,LEN2),PTEXT=""
64 ..I PTEXT'="" S T=$G(PRE)_PTEXT D PRINT(T) S PTEXT=""
65 I PTEXT'="" S T=$G(PRE)_PTEXT D PRINT(T) S PTEXT=""
66 S PSOY=PSOY+PSOYI
67 Q
68 ;
Note: See TracBrowser for help on using the repository browser.