source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDPPRT.m@ 940

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1SDPPRT ;ALB/CAW - Patient Profile - Print ;10/15/93
2 ;;5.3;Scheduling;**6,19,41,140,132**;AUG 13, 1993
3 ;
4EN ;Print entire patient profile
5 ;
6 D ENS^%ZISS
7 D DIR G:SDERR ENQ
8 W !!,$$LINE("Device Selection")
9 S %ZIS="PMQ" D ^%ZIS I POP G ENQ
10 I '$D(IO("Q")) D PRINT G ENQ
11 S Y=$$QUE
12ENQ D:'$D(ZTQUEUED) ^%ZISC
13 K SDERR,SDTYP S VALMBCK="R" Q
14 ;
15QUE() ; -- que job
16 ; return: did job que [ 1|yes 0|no ]
17 ;
18 N X K ZTSK,IO("Q")
19 S ZTDESC="Patient Profile",ZTRTN="PRINT^SDPPRT"
20 F X="DFN","SDACT","SDBD","SDBEG","SDED","SDEND","SDTYP","SDTYP(","SDPRINT","SDRANGE" S ZTSAVE(X)=""
21 D ^%ZTLOAD W:$D(ZTSK) " (Task: ",ZTSK,")"
22 Q $D(ZTSK)
23 ;
24PRINT ;Print actual patient profile
25 U IO N SDWHERE,SDALL,SDGO K ^TMP("SD",$J),^TMP("SDAPT",$J),^TMP("SDENR",$J),^TMP("SDPP",$J),^TMP("SDPPALL",$J)
26 S (SDPAGE,SDTYP)=0,SDGO=1 D INIT1^SDPP,INIT^SDPPALL
27 S (SDALL,SDWHERE)=0 I '$$HDR G PRINTQ
28 F S SDWHERE=$O(^TMP("SDPP",$J,SDWHERE)) Q:'SDWHERE S:($Y+6>IOSL) SDGO=$$HDR G:'SDGO PRINTQ W !,^TMP("SDPP",$J,SDWHERE,0)
29 F S SDALL=$O(^TMP("SDPPALL",$J,SDALL)) Q:'SDALL S:($Y+6>IOSL) SDGO=$$HDR G:'SDGO PRINTQ W !,^TMP("SDPPALL",$J,SDALL,0)
30PRINTQ K ^TMP("SDPP",$J),^TMP("SDPPALL",$J) S SDLN=0 D:'$D(ZTQUEUED) INIT1^SDPP
31 I SDGO,SDPAGE,$E(IOST,1,2)="C-" D PAUSE^VALM1 Q
32 Q
33LINE(STR) ; -- print line
34 ; input: STR := text to insert
35 ; output: none
36 ; return: text to use
37 ;
38 N X
39 S:STR]"" STR=" "_STR_" "
40 S $P(X,"_",(IOM/2)-($L(STR)/2))=""
41 Q X_STR_X
42 ;
43DIR ;Ask what they want printed
44 N SDYN S SDPRINT=1,SDERR=0
45 I $O(^DPT(DFN,"S",SDBD)) D I SDERR G DIRQ
46 .S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to print appointments",DIR("?")="Enter 'NO' if you do not want the appointments, otherwise enter 'YES'."
47 .D ^DIR K DIR I $D(DIRUT) S SDERR=1 Q
48 .I Y S SDTYP(2)=""
49 IF $$EXOE^SDOE(DFN,SDBD,SDED) D I SDERR G DIRQ
50 .S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to print add/edits",DIR("?")="Enter 'NO' if you do not want the add/edits, otherwise enter 'YES'."
51 .D ^DIR K DIR I $D(DIRUT) S SDERR=1 Q
52 .I Y S SDTYP(1)=""
53 I $D(^DPT(DFN,"DE")) D I SDERR G DIRQ
54 .S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to print enrollments",DIR("?")="Enter 'NO' if you do not want the enrollments, otherwise enter 'YES'."
55 .D ^DIR K DIR I $D(DIRUT) S SDERR=1 Q
56 .I Y S SDTYP(4)="",SDACT=0
57 I $D(^DPT(DFN,"DIS")),$S('SDRANGE:1,+$O(^("DIS",9999999-(SDED+.9)))&($O(^(9999999-(SDED+.9)))<(9999999-(SDBD-.1))):1,1:0) D I SDERR G DIRQ
58 .S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to print dispositions",DIR("?")="Enter 'NO' if you do not want the dispositions, otherwise enter 'YES'."
59 .D ^DIR K DIR I $D(DIRUT) S SDERR=1 Q
60 .I Y S SDTYP(3)=""
61 S SDYN=$$LST^DGMTU(DFN) I SDYN D I SDERR G DIRQ
62 .S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to print means test",DIR("?")="Enter 'NO' if you do not want the means test, otherwise enter 'YES'."
63 .D ^DIR K DIR I $D(DIRUT) S SDERR=1 Q
64 .I Y S SDTYP(5)=""
65 ;adding team information - chris mckee 2/6/96
66 S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to print team information",DIR("?")="Enter 'NO' if you do not want the team information, otherwise enter 'YES'."
67 D ^DIR K DIR I $D(DIRUT) S SDERR=1 Q
68 I Y S SDTYP(7)="",GBL="^TMP(""SDPP"","_$J_")"
69DIRQ Q
70 ;
71HDR() ; -- print header
72 ; return: continue processing [ 1|yes 0|no ]
73 ;
74 N Y
75 I SDPAGE,$E(IOST,1,2)="C-" D PAUSE^VALM1 G:'Y HDRQ
76 S SDPAGE=SDPAGE+1 D PID^VADPT6
77 W @IOF,*13,"PATIENT PROFILE: ",$P(^DPT(DFN,0),U)_" ("_VA("BID")_")",?45,$S($D(^DPT(DFN,.1)):"Ward: "_^(.1),1:"Outpatient"),?70,"Page: ",SDPAGE
78 ;
79 W !,"Dates: ",$S(SDBD:$TR($$FMTE^XLFDT(SDBD,"5DF")," ","0"),1:"All"),$S(SDED'=9999999:" to "_$TR($$FMTE^XLFDT(SDED,"5DF")," ","0"),1:" Dates")
80 W ?45,"Report Date: ",$P($$NOW^VALM1,":",1,2)
81 W !,SDASH S Y=1
82HDRQ Q Y
Note: See TracBrowser for help on using the repository browser.