source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRUGPRP.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1DGRUGPRP ;ALB/GRR/SCK - RAI/MDS DATA COLECTION
2 ;;5.3;Registration;**236**;Aug 13, 1993
3EN ; Main entry point
4 N DGDIV,DGSTN,DGSTNUM,DGFILE,DIR,DGPATH,DGDNAM
5 ;
6 ;; ** SCK/Modifications for tasking.
7 S DIR(0)="FAO",DIR("B")=$$PWD^%ZISH
8 S DIR("A",1)=""
9 S DIR("A",2)="Please make a note of the displayed directory path for reference."
10 S DIR("A",3)=""
11 S DIR("A")="Enter the directory path for the file: "
12 S DIR("?",1)="Enter the directory path to write the ASCII data file to."
13 S DIR("?",2)="The default directory path currently in effect is displayed."
14 S DIR("?",3)="You may change the directory path if wish. If you are"
15 S DIR("?",4)="not sure of how to enter the proper directory path for your"
16 S DIR("?",5)="system, press return to accept the default and make a note"
17 S DIR("?")="of the displayed directory path for reference."
18 D ^DIR K DIR
19 Q:$D(DIRUT)
20 S DGPATH=Y
21 ;
22 I '$D(^DG(40.8,"B")) D Q
23 . S DGDIV=$$PRIM^VASITE ;get primary division
24 . S DGSTN=$$SITE^VASITE($$NOW^XLFDT,DGDIV) ;get station info
25 . S DGSTNUM=$P(DGSTN,"^",3) ;get station number
26 . S DGFILE="VA"_DGSTNUM_".TXT" ;set file name
27 . D TASK(DGFILE,DGPATH,DGDIV)
28 ;
29 I $D(^DG(40.8,"B")) D Q ;If multiple divisions
30 . W !!?3,"Building Tasks"
31 . S DGDIV=0,DGDNAM=""
32 . F S DGDNAM=$O(^DG(40.8,"B",DGDNAM)) Q:DGDNAM="" S DGDIV=$O(^DG(40.8,"B",DGDNAM,0)) D
33 . . S DGSTN=$$SITE^VASITE($$NOW^XLFDT,DGDIV) Q:DGSTN=-1 ;get station number
34 . . S DGSTNUM=$P(DGSTN,"^",3) ;get station number
35 . . S DGFILE="VA"_DGSTNUM_".TXT" ;set file name
36 . . D TASK(DGFILE,DGPATH,DGDIV)
37 Q
38 ;
39TASK(DGFILE,DGPATH,DGDIV) ; Task off job
40 N ZTSAVE,ZTRTN,ZTDESC,ZTSK,ZTIO,ZX
41 ;
42 S DGPATH=$G(DGPATH)
43 S:'(DGPATH]"") DGPATH=$$PWD^%ZISH
44 S ZX=""
45 F ZX="DGFILE","DGPATH","DGDIV" S ZTSAVE(ZX)=""
46 S ZTRTN="EN1^DGRUGPRP"
47 S ZTDESC="RAI/MDS Patient Demographic Data Collection"
48 S ZTIO=""
49 W !!?5,"Tasking ",DGFILE,"..."
50 D ^%ZTLOAD
51 I $D(ZTSK)[0 W " Task was not queued!",!
52 E W !?10,"Task queued: ",ZTSK,!
53 Q
54 ;
55EN1 ; Build HFS file
56 N DGNAME,DGWARD,DGIEN,DGWIEN,DGWDIV,DGREC,DGNAME,DOB,SSN,DGRB,DGMS,SEX,DGRACE,DGSTAB,DGADAT,DGATIME,DGHLNM,DGWREC,VADM,VAIP,VAPA,VAERR,POP,DFN,DGEN,DGENP,DGRFA
57 ;
58 Q:$$S^%ZTLOAD ; Quit if the tasked job has been asked to stop
59 S DGPATH=$G(DGPATH)
60 S:'(DGPATH]"") DGPATH=$$PWD^%ZISH
61 D OPEN^%ZISH("FILE1",DGPATH,DGFILE,"W") ; Open HFS file device handler
62 Q:POP ; Quit if the device handler did not open properly
63 U IO
64 S DGWARD="" F S DGWARD=$O(^DGPM("CN",DGWARD)) Q:DGWARD="" S DGIEN=0 F S DGIEN=$O(^DGPM("CN",DGWARD,DGIEN)) Q:DGIEN'>0 D ;loop thru movement file
65 .S DFN=$$GET1^DIQ(405,DGIEN,.03,"I") Q:DFN="" ;get patient ien
66 .S DGRFA=$$GET1^DIQ(405,DGIEN,.11,"I")
67 .S DGRFA=$S(DGRFA=0:"NSC",DGRFA=1:"SC",1:"")
68 .S DGEN=$O(^DGEN(27.11,"C",DFN,""),-1),DGENP=""
69 .I DGEN]"" S DGENP=$$GET1^DIQ(27.11,DGEN,.07,"I")
70 .D DEM^VADPT,IN5^VADPT,ADD^VADPT ;get patient demographics, inpatient data, and address data
71 .S DGWIEN=$P(VAIP(5),"^") Q:DGWIEN="" S DGWDIV=$$GET1^DIQ(42,DGWIEN,.015,"I") ;get ward ien and ward division
72 .Q:$$GET1^DIQ(42,DGWIEN,.035,"I")'=1 ;quit if not rai/mds ward
73 .I DGDIV=DGWDIV D ;if ward division equal to division being processed continue
74 ..S DGNAME=VADM(1),DOB=$P(VADM(3),"^"),SSN=$P(VADM(2),"^"),DGRB=$P(VAIP(6),"^",2),DGMS=$P(VADM(10),"^"),SEX=$P(VADM(5),"^"),DGRACE=$P(VADM(8),"^"),DGSTAB=$S(VAPA(5)]"":$P(^DIC(5,$P(VAPA(5),"^"),0),"^",2),1:"")
75 ..S DGREC=$P(VAIP(13,1),"^") ;get admit date/time
76 ..S DGADAT=$P($P(DGREC,"^"),".") ;grab date
77 ..S DGATIME=$P($P(DGREC,"^"),".",2) ;grab time
78 ..S DGHLNM=$$HLNAME^HLFNC(DGNAME,"^~|\") I $P(DGHLNM,"^",4)="" S $P(DGHLNM,"^",4)="" ;parse name
79 ..S DGWREC=DGHLNM_"^"_$E(DOB,4,5)_"/"_$E(DOB,6,7)_"/"_(1700+$E(DOB,1,3))_"^"_SSN_"^"_SEX_"^"_DGMS_"^"_DGRACE_"^"_$E(DGADAT,4,5)_"/"_$E(DGADAT,6,7)_"/"_(1700+$E(DGADAT,1,3))_"@"_DGATIME_"^"_DGWARD_"/"_DGRB
80 ..S DGWREC=DGWREC_"^"_VAPA(1)_"^"_VAPA(2)_"^"_VAPA(4)_"^"_DGSTAB_"^"_VAPA(6)_"^"_DGENP_"^"_DGRFA
81 .. W DGWREC,!
82 D CLOSE^%ZISH("FILE1") ; close the HFS file handler
83 Q
84 ;
85WARD ;Print Ward/Room/Bed for RAI/MDS wards
86 D EN^XUTMDEVQ("RPT^DGRUGPRP","Print Ward/Room/Bed Report","") ;call device api
87 D HOME^%ZIS
88 Q
89RPT N DGCNT,DGWARD,DGWNAME,DGRB,DGADT,DGRBNM,DGADATE,DGATIME,DGCDT,DGTCNT,DGWCNT
90 S (DGTCNT,DGWCNT)=0
91 D NOW^%DTC S Y=% D DD^%DT S DGCDT=Y ;get current date/time
92 S DGCNT=0
93 S DGWARD=0 F S DGWARD=$O(^DG(405.4,"W",DGWARD)) Q:DGWARD'>0 I $$GET1^DIQ(42,DGWARD,.035,"I")=1 D ;loop through room-bed file, check if ward is rai/mds
94 .S DGWNAME=$$GET1^DIQ(42,DGWARD,".01","I"),DGWCNT=0 ;get ward name
95 .D HED ;do header
96 .S DGRB=0 F S DGRB=$O(^DG(405.4,"W",DGWARD,DGRB)) Q:DGRB'>0 D ;loop thru room-bed for this ward
97 ..S DGRBNM=$$GET1^DIQ(405.4,DGRB,".01","I") ;get room-bed name
98 ..S DGWCNT=DGWCNT+1 ;add one to ward count
99 ..I $Y+4>$G(IOSL) D HED ;if near end of screen, do header
100 ..W !,?5,DGRBNM ;write room-bed name
101 .W !!,"Total beds for ward ",DGWNAME,": ",DGWCNT S DGTCNT=DGTCNT+DGWCNT ;write ward total and add to grand total
102 W !!,"Total Beds for all wards: ",DGTCNT ;write grand total
103 Q
104HED ;FORM FEED AND PRINT HEADER
105 I DGCNT>0 W @IOF
106 S DGCNT=1
107 W !,"RAI/MDS Ward/Room/Beds"
108 W ?40,DGCDT
109 W !,"WARD: ",DGWNAME,!
110 Q
Note: See TracBrowser for help on using the repository browser.