source: WorldVistAEHR/trunk/r/MEDICINE-MC/MCESLIST.m@ 1732

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

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1MCESLIST ;WISC/DCB-This routine will list reports by release status ;5/2/96 09:58
2 ;;2.3;Medicine;;09/13/1996
3START ;
4 N MCAR,MCARCODE,MCARDE,MCARGDT2,MCARGNAM,MCARGNUM,MCARP,MCBP,MCBS
5 N MCEPROC,MCESKEY,MCESON,MCESS,MCESSEC,MCFILE,MCFILE1,MCOUNT
6 N MCPATFLD,MCPOSTP,MCPRO,MCPRTRTN,MCROUT,MCSUP,NOPT,MCOPT,PATN,LOC
7 N PROC,OPTION,DIR,Y,DTOUT,DIRUT,DIROUT,DUOUT,DHIT,DIOEND,DIROUR
8 S OPTION=$P(XQY0,U)
9 S MCPRO=$P(OPTION,"MCESSTATUS",2)
10 K ^TMP($J,"MC","STATUS")
11 D MCPPROC^MCARP1
12 I 'MCESON S MCESSEC=$D(^XUSEC(MCESKEY,DUZ)) W !,"Release Control/Elec Signature is turn off"
13 I 'MCESSEC W !,"You don't have the required key [",MCESKEY,"]" Q
14 D ASK
15 I '$D(OUT) D PRINT
16 K ^TMP($J,"MC","STATUS"),OUT Q
17ASK ;SELECT STATUS
18 S DIR(0)="S^1:Release;2:Draft;3:Both"
19 S DIR("B")="Both"
20 S DIR("A")="Which type of listing do you want see?"
21 S DIR("?",1)="1 Release Status - will only release information"
22 S DIR("?",2)="2 Draft Status - will only show reports that are in draft status"
23 S DIR("?",3)="3 Both - will show all reports"
24 S DIR("?")="Help"
25 D ^DIR I $D(DTOUT)!$D(DIRUT)!$D(DUOUT)!$D(DIROUR) S OUT="" Q
26 S MCOPT=Y
27 Q
28TEST(REC,OPT,MCFILE) ;Screens out information
29 N STATUS,TEST
30 S STATUS=$P($G(^MCAR(MCFILE,REC,"ES")),U,7) S:STATUS="" STATUS="D"
31 S TEST=OPT+$S(STATUS["D":1,1:0)
32 Q $S(STATUS="S":0,OPT=3:1,TEST=1:1,TEST=3:1,1:0)
33STAT ;TOTALS OF STATUS
34 N STATUS
35 S STATUS=$P($G(^MCAR(MCFILE,D0,"ES")),U,7) S:STATUS="" STATUS="NS"
36 S ^TMP($J,"MC","STATUS",STATUS)=$G(^TMP($J,"MC","STATUS",STATUS))+1
37 Q
38PRINT ; Sets up variables for the DIP call
39 N DIS,DHD,DA,DIASKHD,PG,L
40 S L=""
41 S DIC=^DIC(MCFILE,0,"GL")
42 S FLDS=".01;""Date/Time"";C1,"_MCPATFLD_";""Patient"";C22;L30,"""";""Status"";C53,1506;""Status"";C53;W;X",BY=".01"
43 S DIS(0)="I $$TEST^MCESLIST(D0,MCOPT,MCFILE)"
44 S:MCFILE=699 DIS(1)="I $D(^MCAR(697.2,""D"",MCARCODE,+$P(^MCAR(699,+D0,0),U,12)))"
45 S DHD=$S(MCOPT=1:"Release Status Report",MCOPT=2:"Draft Status Report",1:"Status Report"),MCDHD=DHD
46 S DIOEND="D STATUS^MCESLIST"
47 S DHIT="D STAT^MCESLIST"
48 D EN1^DIP
49 Q
50STATUS ; Prints a status count
51 N LOOP,STATUS,INFO,COUNT,TOTAL,LINE,DIR,Y,%
52 S LINE="" S $P(LINE,"-",80)=""
53 I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR I $D(DTOUT)!$D(DIRUT)!$D(DUOUT)!$D(DIROUR) S OUT="" Q
54 W @IOF,MCDHD_" statistics"
55 D NOW^%DTC S Y=% D DD^%DT W ?46,$P(Y,"@")_" "_$P(Y,"@",2)
56 W !,LINE,!!
57 S STATUS=$S(MCOPT=1:"R",MCOPT=2:"D",1:"")
58 F LOOP="D","PD","RV","ROV","RNV","SRV","SROV","NS" D
59 .I LOOP="NS"&(STATUS="D") S STATUS=""
60 .I STATUS=""!(LOOP[STATUS) D
61 ..S COUNT=+$G(^TMP($J,"MC","STATUS",LOOP))
62 ..S TOTAL=$G(TOTAL)+COUNT
63 ..I LOOP'="NS" S INFO=$$STATUS^MCESEDT(MCFILE,LOOP)
64 ..E S INFO="NO STATUS/DRAFT"
65 ..S INFO=$J(INFO,45)_": "
66 ..W !,INFO,?50,$J($FN(COUNT,",",0),10)
67 W !,?50,$E(LINE,1,10),!,?50,$J($FN(TOTAL,",",0),10),!!
68 I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR
69 W @IOF
70 Q
Note: See TracBrowser for help on using the repository browser.