source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRPCR.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: 3.9 KB
Line 
1PRCPRPCR ;WISC/RFJ-patient distribution costs ;11 Mar 94
2 ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 D ^PRCPUSEL Q:'$G(PRCP("I"))
5 I "PS"'[PRCP("DPTYPE") W !,"THIS REPORT SHOULD ONLY BE PRINTED BY THE PRIMARY AND SECONDARY INVENTORY POINTS." Q
6 N DATEEND,DATESTRT,DISTRALL,END,PRCPFITM,PRCPOPCE,PRCPOPCS,PRCPPATE,PRCPPATS,PRCPSUMM,PRCPSURE,PRCPSURS,START,X,Y
7 K X S X(1)="The Patient Distribution Cost Report will print all items distributed to patients for a selected time frame."
8 D DISPLAY^PRCPUX2(40,79,.X)
9 ;
10 ; select the invpts distributing to the patient
11 K ^TMP($J,"PRCPURS3")
12 I PRCP("DPTYPE")="P" D
13 . K X S X(1)="Besides displaying distributions from the "_PRCP("IN")_" inventory point, select other DISTRIBUTION POINTS to display or ALL" W ! D DISPLAY^PRCPUX2(2,40,.X)
14 . D DISTRSEL^PRCPURS3(PRCP("I"))
15 S ^TMP($J,"PRCPURS3","YES",PRCP("I"))=""
16 ;
17 ; summary only ?
18 S PRCPSUMM=$$SUMMARY^PRCPURS0 I PRCPSUMM<0 D Q Q
19 I PRCPSUMM S (PRCPOPCS,PRCPPATS,PRCPSURS)="",(PRCPOPCE,PRCPPATE,PRCPSURE)="z" G GETDATE
20 ;
21 ; select surgical specialty start, end with
22 K X S X(1)="Select the range of surgery specialties to display. For example, start with NEUROSUR, end with NEUROSUR to print the surgery specialty NEUROSURGERY." W ! D DISPLAY^PRCPUX2(5,75,.X)
23 D RANGE("SURGICAL SPECIALTY") I START="^" D Q Q
24 S PRCPSURS=START,PRCPSURE=END
25 ;
26 ; select patient start, end with
27 K X S X(1)="Select the range of patients to display. For example, start with SMITH, end with SMITH to print patients with last names of SMITH." W ! D DISPLAY^PRCPUX2(5,75,.X)
28 D RANGE("PATIENT NAME") I START="^" D Q Q
29 S PRCPPATS=START,PRCPPATE=END
30 ;
31 ; select opcode start, end with
32 K X S X(1)="Select the range of principal procedure codes to display. For example, start with 00124, end with 00126 to print procedure codes including and between 00124 and 00126." W ! D DISPLAY^PRCPUX2(5,75,.X)
33 D RANGE("PRINCIPAL PROCEDURE CODES") I START="^" D Q Q
34 S PRCPOPCS=START,PRCPOPCE=END
35 ;
36 ; print items ?
37 K X S X(1)="You have the option to break out the report by distributed items. If you select this option, the report will probably use a lot of paper to print." W ! D DISPLAY^PRCPUX2(5,75,.X)
38 S XP="Do you want to list out the items distributed",XH="Enter YES to list out the items distributed to the patient."
39 S PRCPFITM=$$YN^PRCPUYN(2) I 'PRCPFITM D Q Q
40 ;
41GETDATE ; select date range
42 K X S X(1)="Select the date range for displaying patient distribution costs" W ! D DISPLAY^PRCPUX2(2,40,.X)
43 D DATESEL^PRCPURS2("") I '$G(DATESTRT) D Q Q
44 W ! S %ZIS="Q" D ^%ZIS G:POP Q I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK D Q Q
45 . S ZTDESC="Patient Distribution Cost Report",ZTRTN="DQ^PRCPRPCR"
46 . S ZTSAVE("PRCP*")="",ZTSAVE("D*")="",ZTSAVE("^TMP($J,""PRCPURS3"",")="",ZTSAVE("ZTREQ")="@"
47 W !!,"<*> please wait <*>"
48DQ ; queue starts here
49 N %,%I,AVERAGE,DA,DATA,DATE,DFN,DISTRNM,DISTRPT,INOUTPAT,ITEMDA,NOW,OPCODE,PAGE,PATNAME,PRCPFLAG,PRCPFTOT,SCREEN,SSN,SURGDATA,SURGEON,SURGSPEC,TOTCOST,VA,VADM,VAERR,X,Y
50 D SORT^PRCPRPC1
51 D PRINT^PRCPRPC2
52Q D ^%ZISC K ^TMP($J,"PRCPURS3"),^TMP($J,"PRCPRPCR"),^TMP($J,"PRCPRPCRT")
53 Q
54 ;
55 ;
56RANGE(TYPE) ; start with end with for type
57 ; return variables start and end
58 N X
59 K START,END
60 F D Q:$D(START)
61 . W !,"START with ",TYPE,": FIRST// " R X:DTIME I '$T!(X["^") S START="^" Q
62 . I X["?" K X S X(1)="Select the starting "_TYPE_". If you select the default FIRST entry, NULL entries will be selected." D DISPLAY^PRCPUX2(5,75,.X) Q
63 . S START=X
64 I START="^" Q
65 F D Q:$D(END)
66 . W !," END with ",TYPE,": LAST// " R X:DTIME I '$T!(X["^") S END="^" Q
67 . I X["?" K X S X(1)="Select the ending "_TYPE_". The ending "_TYPE_" should be the same or follow after the starting "_TYPE_"." D DISPLAY^PRCPUX2(5,75,.X) Q
68 . I X="" S X="z"
69 . I START]X K X S X(1)="Ending "_TYPE_" must follow starting "_TYPE_"." D DISPLAY^PRCPUX2(5,75,.X) Q
70 . S END=X
71 I END="^" S START="^"
72 Q
Note: See TracBrowser for help on using the repository browser.