Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGRUGPRP

DGRUGPRP.m

Go to the documentation of this file.
  1. DGRUGPRP ;ALB/GRR/SCK - RAI/MDS DATA COLECTION
  1. ;;5.3;Registration;**236,1015**;Aug 13, 1993;Build 21
  1. EN ; Main entry point
  1. N DGDIV,DGSTN,DGSTNUM,DGFILE,DIR,DGPATH,DGDNAM
  1. ;
  1. ;; ** SCK/Modifications for tasking.
  1. S DIR(0)="FAO",DIR("B")=$$PWD^%ZISH
  1. S DIR("A",1)=""
  1. S DIR("A",2)="Please make a note of the displayed directory path for reference."
  1. S DIR("A",3)=""
  1. S DIR("A")="Enter the directory path for the file: "
  1. S DIR("?",1)="Enter the directory path to write the ASCII data file to."
  1. S DIR("?",2)="The default directory path currently in effect is displayed."
  1. S DIR("?",3)="You may change the directory path if wish. If you are"
  1. S DIR("?",4)="not sure of how to enter the proper directory path for your"
  1. S DIR("?",5)="system, press return to accept the default and make a note"
  1. S DIR("?")="of the displayed directory path for reference."
  1. D ^DIR K DIR
  1. Q:$D(DIRUT)
  1. S DGPATH=Y
  1. ;
  1. I '$D(^DG(40.8,"B")) D Q
  1. . S DGDIV=$$PRIM^VASITE ;get primary division
  1. . S DGSTN=$$SITE^VASITE($$NOW^XLFDT,DGDIV) ;get station info
  1. . S DGSTNUM=$P(DGSTN,"^",3) ;get station number
  1. . S DGFILE="VA"_DGSTNUM_".TXT" ;set file name
  1. . D TASK(DGFILE,DGPATH,DGDIV)
  1. ;
  1. I $D(^DG(40.8,"B")) D Q ;If multiple divisions
  1. . W !!?3,"Building Tasks"
  1. . S DGDIV=0,DGDNAM=""
  1. . F S DGDNAM=$O(^DG(40.8,"B",DGDNAM)) Q:DGDNAM="" S DGDIV=$O(^DG(40.8,"B",DGDNAM,0)) D
  1. . . S DGSTN=$$SITE^VASITE($$NOW^XLFDT,DGDIV) Q:DGSTN=-1 ;get station number
  1. . . S DGSTNUM=$P(DGSTN,"^",3) ;get station number
  1. . . S DGFILE="VA"_DGSTNUM_".TXT" ;set file name
  1. . . D TASK(DGFILE,DGPATH,DGDIV)
  1. Q
  1. ;
  1. TASK(DGFILE,DGPATH,DGDIV) ; Task off job
  1. N ZTSAVE,ZTRTN,ZTDESC,ZTSK,ZTIO,ZX
  1. ;
  1. S DGPATH=$G(DGPATH)
  1. S:'(DGPATH]"") DGPATH=$$PWD^%ZISH
  1. S ZX=""
  1. F ZX="DGFILE","DGPATH","DGDIV" S ZTSAVE(ZX)=""
  1. S ZTRTN="EN1^DGRUGPRP"
  1. S ZTDESC="RAI/MDS Patient Demographic Data Collection"
  1. S ZTIO=""
  1. W !!?5,"Tasking ",DGFILE,"..."
  1. D ^%ZTLOAD
  1. I $D(ZTSK)[0 W " Task was not queued!",!
  1. E W !?10,"Task queued: ",ZTSK,!
  1. Q
  1. ;
  1. EN1 ; Build HFS file
  1. 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
  1. ;
  1. Q:$$S^%ZTLOAD ; Quit if the tasked job has been asked to stop
  1. S DGPATH=$G(DGPATH)
  1. S:'(DGPATH]"") DGPATH=$$PWD^%ZISH
  1. D OPEN^%ZISH("FILE1",DGPATH,DGFILE,"W") ; Open HFS file device handler
  1. Q:POP ; Quit if the device handler did not open properly
  1. U IO
  1. 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
  1. .S DFN=$$GET1^DIQ(405,DGIEN,.03,"I") Q:DFN="" ;get patient ien
  1. .S DGRFA=$$GET1^DIQ(405,DGIEN,.11,"I")
  1. .S DGRFA=$S(DGRFA=0:"NSC",DGRFA=1:"SC",1:"")
  1. .S DGEN=$O(^DGEN(27.11,"C",DFN,""),-1),DGENP=""
  1. .I DGEN]"" S DGENP=$$GET1^DIQ(27.11,DGEN,.07,"I")
  1. .D DEM^VADPT,IN5^VADPT,ADD^VADPT ;get patient demographics, inpatient data, and address data
  1. .S DGWIEN=$P(VAIP(5),"^") Q:DGWIEN="" S DGWDIV=$$GET1^DIQ(42,DGWIEN,.015,"I") ;get ward ien and ward division
  1. .Q:$$GET1^DIQ(42,DGWIEN,.035,"I")'=1 ;quit if not rai/mds ward
  1. .I DGDIV=DGWDIV D ;if ward division equal to division being processed continue
  1. ..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:"")
  1. ..S DGREC=$P(VAIP(13,1),"^") ;get admit date/time
  1. ..S DGADAT=$P($P(DGREC,"^"),".") ;grab date
  1. ..S DGATIME=$P($P(DGREC,"^"),".",2) ;grab time
  1. ..S DGHLNM=$$HLNAME^HLFNC(DGNAME,"^~|\") I $P(DGHLNM,"^",4)="" S $P(DGHLNM,"^",4)="" ;parse name
  1. ..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
  1. ..S DGWREC=DGWREC_"^"_VAPA(1)_"^"_VAPA(2)_"^"_VAPA(4)_"^"_DGSTAB_"^"_VAPA(6)_"^"_DGENP_"^"_DGRFA
  1. .. W DGWREC,!
  1. D CLOSE^%ZISH("FILE1") ; close the HFS file handler
  1. Q
  1. ;
  1. WARD ;Print Ward/Room/Bed for RAI/MDS wards
  1. D EN^XUTMDEVQ("RPT^DGRUGPRP","Print Ward/Room/Bed Report","") ;call device api
  1. D HOME^%ZIS
  1. Q
  1. RPT N DGCNT,DGWARD,DGWNAME,DGRB,DGADT,DGRBNM,DGADATE,DGATIME,DGCDT,DGTCNT,DGWCNT
  1. S (DGTCNT,DGWCNT)=0
  1. D NOW^%DTC S Y=% D DD^%DT S DGCDT=Y ;get current date/time
  1. S DGCNT=0
  1. 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
  1. .S DGWNAME=$$GET1^DIQ(42,DGWARD,".01","I"),DGWCNT=0 ;get ward name
  1. .D HED ;do header
  1. .S DGRB=0 F S DGRB=$O(^DG(405.4,"W",DGWARD,DGRB)) Q:DGRB'>0 D ;loop thru room-bed for this ward
  1. ..S DGRBNM=$$GET1^DIQ(405.4,DGRB,".01","I") ;get room-bed name
  1. ..S DGWCNT=DGWCNT+1 ;add one to ward count
  1. ..I $Y+4>$G(IOSL) D HED ;if near end of screen, do header
  1. ..W !,?5,DGRBNM ;write room-bed name
  1. .W !!,"Total beds for ward ",DGWNAME,": ",DGWCNT S DGTCNT=DGTCNT+DGWCNT ;write ward total and add to grand total
  1. W !!,"Total Beds for all wards: ",DGTCNT ;write grand total
  1. Q
  1. HED ;FORM FEED AND PRINT HEADER
  1. I DGCNT>0 W @IOF
  1. S DGCNT=1
  1. W !,"RAI/MDS Ward/Room/Beds"
  1. W ?40,DGCDT
  1. W !,"WARD: ",DGWNAME,!
  1. Q