source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOANCQ.m@ 1800

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

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1ONCOANCQ ;Hines OIFO/GWB - [ER Report of accessions requiring additional input] ;06/14/00
2 ;;2.11;ONCOLOGY;**1,16,18,25,26**;Mar 07, 1995
3 ;
4 S AASTYPNC="A"
5LINE N AASAY ; year to gather for
6 N READY ; our UNTIL-condition variable
7 FOR D Q:READY ; ask over and over again UNTIL ok or bailout
8 . S READY=0 ; initialize UNTIL condition
9 . I '$$SITEPAR^ONCOU("ERRMSG") S READY=-1 ; if no site parameters on file, notify user and bail out
10 . E I '$$GETDATA S READY=-1 ; get data - did user bail out? yes, note in UNTIL-condition
11 . E S READY=$$DEFOK ; no, make sure definitions are OK
12 . I 'READY W !!!?10,"OK, restarting from the beginning...",!!!
13 . Q
14 ;END FOR
15 ;
16 I READY>0 D ^ONCOANC0 ; A-OK, proceed
17 QUIT ; we bailed out
18 ;
19GETDATA() ; main data-gathering loop
20 N ALLOK ; bailout flag
21 S ALLOK=$$SHOINST ; display instructions
22 I ALLOK S AASAY=0,ALLOK=$$GETYEAR(.AASAY) ; get accession year
23 I ALLOK D STATE S:'$D(BYR("B")) BYR("B")=(200+EYR)_"0000" S:'$D(BYR("E")) BYR("E")=(201+EYR)_"0000"
24 I ALLOK S AASDXH=0,ALLOK=$$GETDXH(.AASDXH) ; get ACoS hosp number
25 Q ALLOK
26 ;
27SHOINST() ; display instructions
28 N OKSHO,OKHERE S OKHERE=1 ; assume the best
29 S OKSHO=$$ASKY^ONCOU(" DISPLAY/PRINT on-line instructions for Help")
30 I $D(DIRUT)!$D(DIROUT) S OKHERE=0 ; they bailed out
31 E I OKSHO,'($D(ONCOREP)!$D(ONCOREQ)) S OKHERE=$$SHOWEM ; display the instructions
32 E I OKSHO,($D(ONCOREP)!$D(ONCOREQ)) D TEMPHLP
33 Q OKHERE
34 ;
35TEMPHLP N X,DIWL,DIWR,DIWF
36 S DIWL=10,DIWR=70,DIWF="W"
37 W !!
38 I $D(ONCOREQ) D
39 .S X="This report displays incomplete records for data to be transmitted to the ACOS, for a time period specified. The report does not specify exactly where in the database to fix problems. It is intended only as an aid."
40 E D
41 .S X="This report will display what will be transmitted on the ACOS disk. It is intended as an aid in correcting and validating the ACOS data. There is no extensive help for this report at this time."
42 D ^DIWP,^DIWW W !
43 Q
44SHOWEM() ; main body of instruction display
45 N OKHERE
46 W !! S DIC="^ONCO(160.2,",L=0,DHD="@"
47 I AASTYPNC="A" S BY="[ONCO ACOS DOCUMENTATION]",DA=4
48 I AASTYPNC="I" S FLDS="1",FR="PRIMARY ACOS INFO (850)",TO="STATE REPORTING ACOS INFOA",BY="@.01"
49 D EN1^DIP
50 S OKHERE=($D(DTOUT)+$D(DUOUT)=0)
51 I 'OKHERE S OKHERE=$$ASKY^ONCOU("Continue")
52 Q OKHERE
53 ;
54GETYEAR(YR) ; get the year to return
55 N OKHERE
56 S BYR=1980,EYR=(1700+$E(DT,1,3))-1 ; Why restrict the year?
57 S:AASTYPNC'="A" YR=$$ASKNUM^ONCOU(" Select YEAR for ACOS Call for Data",BYR_":"_(BYR+20),EYR)
58 I AASTYPNC="A" S YR=$$ASKNUM^ONCOU(" Select Accession Year",BYR_":"_(BYR+20),EYR)
59 S OKHERE=($D(DTOUT)+$D(DUOUT)=0)
60 Q OKHERE
61 ;
62GETDXH(DXH) ;Get INSTITUTION ID NUMBER (160.1,27)
63 N OKHERE
64 S DIE=160.1
65 S DA=$O(^ONCO(160.1,"C",DUZ(2),0))
66 I DA="" S DA=$O(^ONCO(160.1,0))
67 S DR=27_$J("",20)_"ACOS Number"
68 S ONCOL=0
69 L +^ONCO(160.1,DA):0 I $T D ^DIE L -^ONCO(160.1,DA) S ONCOL=1
70 I 'ONCOL W !,"The site paramaters record is being edited by another user."
71 K ONCOL
72 K DIE S DXH=X
73 S OKHERE=($D(Y)=0) ; Y is defined if user answered all prompts
74 Q OKHERE
75 ;
76DEFOK() ;Confirm definitions
77 N OKHERE
78 S OSP=$O(^ONCO(160.1,"C",DUZ(2),0))
79 I OSP="" S OSP=$O(^ONCO(160.1,0))
80 S AC=$P(^ONCO(160.1,OSP,1),U,4)
81 S AC=$$GET1^DIQ(160.19,AC,.01,"I")
82 K OSP
83 W !!!?20,"ACOS Number is ",$S(AC'="":AC,1:"NOT defined in Site Parameters File") S:AC'="" AASDXH=AC
84 W:AASTYPNC="I" !?20,"Year for ACOS data is ",AASAY
85 I AASTYPNC="A" W !?20,"Accession Year for State data is ",AASAY,!?20,"Abstract Completed Date, Start is ",BYR("BY"),!?20,"Abstract Completed Date, End is ",BYR("BE")
86 W ! S OKHERE=$$ASKY^ONCOU(" Definitions OK")
87 Q OKHERE
88REPORT ;Set variable for report to run instead of tape
89 N ONCOREP
90 S ONCOREP=1,AASTYPNC="I" D LINE^ONCOANCQ,CLEANUP^ONCOANC9 Q
91REQREP ;Set variable for required field report to run
92 N ONCOREQ
93 S ONCOREQ=1 D ^ONCOANCQ,CLEANUP^ONCOANC9 Q
94STATE ;Identifies desired date range for state data collection disk
95 Q:AASTYPNC'="A" I AASAY'>1 S ALLOK=0 Q
96 S DIR(0)="D",DIR("A")=" Abstract Completed Date, Start"
97 S DIR("B")="Jan 1, "_AASAY D ^DIR K DIR("B") I $D(DIRUT) S ALLOK=0 Q
98 S BYR("B")=Y X ^DD("DD") W " ",Y S BYR("BY")=Y
99 S DIR("A")=" Abstract Completed Date, End",DIR("B")="Dec 31, "_AASAY
100 D ^DIR I $D(DIRUT) S ALLOK=0 Q
101 S BYR("E")=Y X ^DD("DD") W " ",Y S BYR("BE")=Y
102 K DIR
103 Q
Note: See TracBrowser for help on using the repository browser.