source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPR00.m@ 1450

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

initial load of WorldVistAEHR
File size: 4.9 KB
RevLine 
[613]1ORPR00 ; slc/dcm - Prints Charming ;5/10/01 10:10
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**5,11,69,99,95**;Dec 17, 1997
3EN ;Formatter
4 N ORIOF,D,DA,D0,DI,DIC,DE,DQ,DIE,DR,DTOUT,DUOUT,Y,ORFMT,DLAYGO,ORK,%,%Y,%X,Y,I
5 S DIC="^ORD(100.23,",DIC(0)="AEMQL",DLAYGO=100.23
6 D ^DIC I Y<0 G OUT
7 S (ORFMT,DA)=+Y,DIE="^ORD(100.23,",DR="[OR PRINT FORMAT EDIT]"
8 D ^DIE
9 I '$D(^ORD(100.23,ORFMT,0)) G OUT
10ASK W !!," OK to compile print format"
11 S %=1 D YN^DICN
12 Q:%=-1
13 I %=0 W !,"Answer YES to incorporate changes made into the compiled code." G ASK
14 Q:%=2
15 S ORK=0 F S ORK=$O(^ORD(100.22,ORK)) Q:ORK'>0 I $D(^(ORK,0)),$L($P(^(0),"^",4)) S @$P(^(0),"^",4)=$P(^(0),"^",3)
16 D CMPL
17 W !!,"|||||------------------------ Column Numbers ------------------------|||||"
18 W !,"0---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8"
19 W !,"1 0 0 0 0 0 0 0 0"
20 S ORIOF=IOF,IOF="!"
21 D PRINT(ORFMT,1,1)
22 W !
23 S IOF=ORIOF
24 D CMPL^ORPR010(ORFMT)
25 G EN
26OUT ;Clean-up before exit
27 S ORK=0 F S ORK=$O(^ORD(100.22,ORK)) Q:ORK'>0 I $D(^(ORK,0)),$L($P(^(0),"^",4)) K @$P(^(0),"^",4)
28 Q
29CMPL ;Compile print code for output
30 N X,I,ORROW,ORK,ORVAR,ORFL,ORAN,ORV,ORCL,OROJ,ORPT
31 Q:'$D(^ORD(100.23,ORFMT,0)) S X=^(0)
32 S ORROW=$S($P(X,"^",2):$P(X,"^",2),1:6)
33 K ^ORD(100.23,ORFMT,2)
34 S ORK=0 F S ORK=$O(^ORD(100.23,ORFMT,1,ORK)) Q:ORK'>0 I $D(^(ORK,0)) S X=^(0) D
35 . S ^TMP("OR",$J,"FMT",+$P(X,"^",2),+$P(X,"^",3),$P(X,"^"))=$P(X,"^",4,7)
36 S ORAN=1,(ORFL,ORV)=0
37 F ORK=1:1:ORROW S:ORK>1 ORFL=1 D
38 . I '$D(^TMP("OR",$J,"FMT",ORK)) S ^ORD(100.23,ORFMT,2,ORAN,0)="W !",ORAN=ORAN+1 Q
39 . S ORCL=0 F S ORCL=$O(^TMP("OR",$J,"FMT",ORK,ORCL)) Q:ORCL'>0 S ORPT=$O(^(ORCL,"")),OROJ=^(ORPT) D STUF
40 I $O(ORVAR(0)) S ORAN=ORAN+1 S I=0,X="X" D
41 .F S I=$O(ORVAR(I)) Q:I<1 S X=X_","_ORVAR(I)
42 .S ^ORD(100.23,ORFMT,2,ORAN,0)="K "_X
43 S ^ORD(100.23,ORFMT,2,0)="^^"_ORAN_"^"_(ORAN+1)_"^"_DT
44 I '$D(DIFROM) W !!?3,"... '",$P(^ORD(100.23,ORFMT,0),"^"),"' format has been compiled."
45 K ^TMP("OR",$J,"FMT")
46 Q
47STUF ;
48 I $P(^ORD(100.22,+ORPT,0),"^",6),$D(^(1)),$L(^(1)) S ^ORD(100.23,ORFMT,2,ORAN,0)=^ORD(100.22,+ORPT,1),ORAN=ORAN+1 Q ;Direct execute (not compiled)
49 N ORDEF,ORFUN,ORPRM,ORTL
50 S ORVAR="DT",ORDEF=""
51 S:$D(^ORD(100.22,+ORPT,0)) ORVAR=$P(^(0),"^",4),ORDEF=$P(^(0),"^",2),ORFUN=$P(^(0),"^",5) I $D(^(1)),$L(^(1)) S ORV=ORV+1,ORVAR(ORV)=ORVAR
52 I ORFUN="WORD"!(ORFUN="TEXT")!(ORFUN="TEXTWRAP")!(ORFUN="TMPWRAP"),(@ORVAR="WORD")!(@ORVAR="TEXT") S @ORVAR="^ORD(100.22,"_+ORPT_",2)"
53 S ORTL=$S(ORVAR="ORFREE":"",$P(OROJ,"^")="NONE":"",$P(OROJ,"^")]"":$P(OROJ,"^"),1:ORDEF),ORPRM=""""_$P(OROJ,"^",3)_"""",ORTL=""""_ORTL_""""
54 I $P(OROJ,"^",4),$L(ORVAR),ORVAR'="ORFREE" S ORTL="$S($L($G("_ORVAR_")):"_ORTL_",1:"""")"
55 S ^ORD(100.23,ORFMT,2,ORAN,0)="W"_$S(ORVAR["ORTX":":$L($G("_ORVAR_")) ",1:" ")_$S(ORFL:"!",1:"")_"?"_(ORCL-1)_","_ORTL_","_$S(ORVAR="ORFREE":""""_$P(OROJ,"^",2)_"""",$L(ORFUN):"$$"_ORFUN_"^ORU($G("_ORVAR_"),"_ORPRM_")",1:"$G("_ORVAR_")")
56 S ORAN=ORAN+1,ORFL=0
57 Q
58PRINT(FMT,NUM,TEST,SNUM,ORSCREEN) ;
59 ;FMT=Format ptr in ^ORD(100.23,FMT
60 ;NUM=# of times to print
61 ;TEST=1 using test data
62 ;$D(SNUM) Suppresses form feed
63 ;ORSCREEN=Mumps code envoked when item is screened
64 ;^TMP("ORP:",$J,... may be used by a print field
65 Q:'$G(FMT) Q:'$D(^ORD(100.23,FMT,0))
66 N ORKI,ORK,X,ORTEST
67 K ^TMP("ORP:",$J)
68 S ORTEST=$G(TEST)
69 S:'$D(NUM) NUM=1 S:'$D(TEST) TEST=0
70 I 'TEST,$D(^ORD(100.23,FMT,3)),$L(^(3)) X ^(3) I '$T W:$E(IOST,1,2)="C-" !,"This item has been screened from printing." X:$L($G(ORSCREEN)) ORSCREEN H 2 Q
71 F ORKI=1:1:NUM Q:$G(OREND) D
72 . I 'TEST S ORK=0 F S ORK=$O(^ORD(100.23,FMT,1,ORK)) Q:ORK'>0 I $D(^(ORK,0)) S X=+^(0) D
73 .. I $G(ORIFN),$D(^ORD(100.22,+X,0)),$P(^(0),"^",7),$P(^(0),"^",7)'=$P($G(^OR(100,ORIFN,0)),"^",14) Q
74 .. I $D(^ORD(100.22,+X,1)),'$P(^(0),"^",6) X ^(1)
75 . W:'$G(SNUM)!($E(IOST,1,2)="C-") @IOF W $C(13)
76 . S ORK=0 F S ORK=$O(^ORD(100.23,FMT,2,ORK)) Q:ORK'>0 X ^ORD(100.23,FMT,2,ORK,0) Q:$G(OREND)
77 . K ^TMP("ORP:",$J)
78 . I $G(SNUM),NUM>1 W @IOF
79 I $P(^ORD(100.23,FMT,0),"^",5),$G(NUM)<2 W @IOF
80 Q
81RECMPL ;Recompile all print formats
82 N IFN,ORK,X,ORFMT K ^TMP("OR",$J,"FMT")
83 S IFN=0
84 F S IFN=$O(^ORD(100.23,IFN)) Q:IFN<1 S ORFMT=IFN D
85 . S ORK=0 F S ORK=$O(^ORD(100.22,ORK)) Q:ORK'>0 I $D(^(ORK,0)),$L($P(^(0),"^",4)) S @$P(^(0),"^",4)=$P(^(0),"^",3)
86 . D CMPL
87 . D CMPL^ORPR010(ORFMT)
88 D OUT
89 Q
90TEST(FMT,ORIFN,OACTION,ORVP,LOC,GIOM) ;Test display of a print format
91 Q:'$G(FMT)
92 W @IOF
93 N X,IOM,IOF,TEST,OREND,ORPDAD
94 Q:'$D(^OR(100,$G(ORIFN),0)) S X=^(0)
95 S:'$G(OACTION) OACTION=1
96 S:'$D(ORVP) ORVP=$P(X,"^",2)
97 S:'$D(LOC) LOC=+$P(X,"^",10)
98 S:'$G(GIOM) GIOM=79
99 S IOM=GIOM,IOF="!",TEST=0
100 D PRINT(FMT)
101 Q
10222 ;Remove Print fields and Print format entries above #1000
103 N Y,DIK,ORK,DA
104 X ^%ZOSF("UCI") Q:Y="DEV,CUR" Q:Y="OEX,ROX"
105 S DIK="^ORD(100.22,"
106 F ORK=1000:0 S ORK=$O(^ORD(100.22,ORK)) Q:ORK<1 S DA=ORK D ^DIK
107 S DIK="^ORD(100.23,"
108 F ORK=1000:0 S ORK=$O(^ORD(100.23,ORK)) Q:ORK<1 S DA=ORK D ^DIK
109 Q
Note: See TracBrowser for help on using the repository browser.