DGRUGPRP ;ALB/GRR/SCK - RAI/MDS DATA COLECTION
;;5.3;Registration;**236**;Aug 13, 1993
EN ; Main entry point
N DGDIV,DGSTN,DGSTNUM,DGFILE,DIR,DGPATH,DGDNAM
;
;; ** SCK/Modifications for tasking.
S DIR(0)="FAO",DIR("B")=$$PWD^%ZISH
S DIR("A",1)=""
S DIR("A",2)="Please make a note of the displayed directory path for reference."
S DIR("A",3)=""
S DIR("A")="Enter the directory path for the file: "
S DIR("?",1)="Enter the directory path to write the ASCII data file to."
S DIR("?",2)="The default directory path currently in effect is displayed."
S DIR("?",3)="You may change the directory path if wish. If you are"
S DIR("?",4)="not sure of how to enter the proper directory path for your"
S DIR("?",5)="system, press return to accept the default and make a note"
S DIR("?")="of the displayed directory path for reference."
D ^DIR K DIR
Q:$D(DIRUT)
S DGPATH=Y
;
I '$D(^DG(40.8,"B")) D Q
. S DGDIV=$$PRIM^VASITE ;get primary division
. S DGSTN=$$SITE^VASITE($$NOW^XLFDT,DGDIV) ;get station info
. S DGSTNUM=$P(DGSTN,"^",3) ;get station number
. S DGFILE="VA"_DGSTNUM_".TXT" ;set file name
. D TASK(DGFILE,DGPATH,DGDIV)
;
I $D(^DG(40.8,"B")) D Q ;If multiple divisions
. W !!?3,"Building Tasks"
. S DGDIV=0,DGDNAM=""
. F S DGDNAM=$O(^DG(40.8,"B",DGDNAM)) Q:DGDNAM="" S DGDIV=$O(^DG(40.8,"B",DGDNAM,0)) D
. . S DGSTN=$$SITE^VASITE($$NOW^XLFDT,DGDIV) Q:DGSTN=-1 ;get station number
. . S DGSTNUM=$P(DGSTN,"^",3) ;get station number
. . S DGFILE="VA"_DGSTNUM_".TXT" ;set file name
. . D TASK(DGFILE,DGPATH,DGDIV)
Q
;
TASK(DGFILE,DGPATH,DGDIV) ; Task off job
N ZTSAVE,ZTRTN,ZTDESC,ZTSK,ZTIO,ZX
;
S DGPATH=$G(DGPATH)
S:'(DGPATH]"") DGPATH=$$PWD^%ZISH
S ZX=""
F ZX="DGFILE","DGPATH","DGDIV" S ZTSAVE(ZX)=""
S ZTRTN="EN1^DGRUGPRP"
S ZTDESC="RAI/MDS Patient Demographic Data Collection"
S ZTIO=""
W !!?5,"Tasking ",DGFILE,"..."
D ^%ZTLOAD
I $D(ZTSK)[0 W " Task was not queued!",!
E W !?10,"Task queued: ",ZTSK,!
Q
;
EN1 ; Build HFS file
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
;
Q:$$S^%ZTLOAD ; Quit if the tasked job has been asked to stop
S DGPATH=$G(DGPATH)
S:'(DGPATH]"") DGPATH=$$PWD^%ZISH
D OPEN^%ZISH("FILE1",DGPATH,DGFILE,"W") ; Open HFS file device handler
Q:POP ; Quit if the device handler did not open properly
U IO
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
.S DFN=$$GET1^DIQ(405,DGIEN,.03,"I") Q:DFN="" ;get patient ien
.S DGRFA=$$GET1^DIQ(405,DGIEN,.11,"I")
.S DGRFA=$S(DGRFA=0:"NSC",DGRFA=1:"SC",1:"")
.S DGEN=$O(^DGEN(27.11,"C",DFN,""),-1),DGENP=""
.I DGEN]"" S DGENP=$$GET1^DIQ(27.11,DGEN,.07,"I")
.D DEM^VADPT,IN5^VADPT,ADD^VADPT ;get patient demographics, inpatient data, and address data
.S DGWIEN=$P(VAIP(5),"^") Q:DGWIEN="" S DGWDIV=$$GET1^DIQ(42,DGWIEN,.015,"I") ;get ward ien and ward division
.Q:$$GET1^DIQ(42,DGWIEN,.035,"I")'=1 ;quit if not rai/mds ward
.I DGDIV=DGWDIV D ;if ward division equal to division being processed continue
..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:"")
..S DGREC=$P(VAIP(13,1),"^") ;get admit date/time
..S DGADAT=$P($P(DGREC,"^"),".") ;grab date
..S DGATIME=$P($P(DGREC,"^"),".",2) ;grab time
..S DGHLNM=$$HLNAME^HLFNC(DGNAME,"^~|\") I $P(DGHLNM,"^",4)="" S $P(DGHLNM,"^",4)="" ;parse name
..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
..S DGWREC=DGWREC_"^"_VAPA(1)_"^"_VAPA(2)_"^"_VAPA(4)_"^"_DGSTAB_"^"_VAPA(6)_"^"_DGENP_"^"_DGRFA
.. W DGWREC,!
D CLOSE^%ZISH("FILE1") ; close the HFS file handler
Q
;
WARD ;Print Ward/Room/Bed for RAI/MDS wards
D EN^XUTMDEVQ("RPT^DGRUGPRP","Print Ward/Room/Bed Report","") ;call device api
D HOME^%ZIS
Q
RPT N DGCNT,DGWARD,DGWNAME,DGRB,DGADT,DGRBNM,DGADATE,DGATIME,DGCDT,DGTCNT,DGWCNT
S (DGTCNT,DGWCNT)=0
D NOW^%DTC S Y=% D DD^%DT S DGCDT=Y ;get current date/time
S DGCNT=0
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
.S DGWNAME=$$GET1^DIQ(42,DGWARD,".01","I"),DGWCNT=0 ;get ward name
.D HED ;do header
.S DGRB=0 F S DGRB=$O(^DG(405.4,"W",DGWARD,DGRB)) Q:DGRB'>0 D ;loop thru room-bed for this ward
..S DGRBNM=$$GET1^DIQ(405.4,DGRB,".01","I") ;get room-bed name
..S DGWCNT=DGWCNT+1 ;add one to ward count
..I $Y+4>$G(IOSL) D HED ;if near end of screen, do header
..W !,?5,DGRBNM ;write room-bed name
.W !!,"Total beds for ward ",DGWNAME,": ",DGWCNT S DGTCNT=DGTCNT+DGWCNT ;write ward total and add to grand total
W !!,"Total Beds for all wards: ",DGTCNT ;write grand total
Q
HED ;FORM FEED AND PRINT HEADER
I DGCNT>0 W @IOF
S DGCNT=1
W !,"RAI/MDS Ward/Room/Beds"
W ?40,DGCDT
W !,"WARD: ",DGWNAME,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRUGPRP 5273 printed Sep 23, 2025@20:34:24 Page 2
DGRUGPRP ;ALB/GRR/SCK - RAI/MDS DATA COLECTION
+1 ;;5.3;Registration;**236**;Aug 13, 1993
EN ; Main entry point
+1 NEW DGDIV,DGSTN,DGSTNUM,DGFILE,DIR,DGPATH,DGDNAM
+2 ;
+3 ;; ** SCK/Modifications for tasking.
+4 SET DIR(0)="FAO"
SET DIR("B")=$$PWD^%ZISH
+5 SET DIR("A",1)=""
+6 SET DIR("A",2)="Please make a note of the displayed directory path for reference."
+7 SET DIR("A",3)=""
+8 SET DIR("A")="Enter the directory path for the file: "
+9 SET DIR("?",1)="Enter the directory path to write the ASCII data file to."
+10 SET DIR("?",2)="The default directory path currently in effect is displayed."
+11 SET DIR("?",3)="You may change the directory path if wish. If you are"
+12 SET DIR("?",4)="not sure of how to enter the proper directory path for your"
+13 SET DIR("?",5)="system, press return to accept the default and make a note"
+14 SET DIR("?")="of the displayed directory path for reference."
+15 DO ^DIR
KILL DIR
+16 if $DATA(DIRUT)
QUIT
+17 SET DGPATH=Y
+18 ;
+19 IF '$DATA(^DG(40.8,"B"))
Begin DoDot:1
+20 ;get primary division
SET DGDIV=$$PRIM^VASITE
+21 ;get station info
SET DGSTN=$$SITE^VASITE($$NOW^XLFDT,DGDIV)
+22 ;get station number
SET DGSTNUM=$PIECE(DGSTN,"^",3)
+23 ;set file name
SET DGFILE="VA"_DGSTNUM_".TXT"
+24 DO TASK(DGFILE,DGPATH,DGDIV)
End DoDot:1
QUIT
+25 ;
+26 ;If multiple divisions
IF $DATA(^DG(40.8,"B"))
Begin DoDot:1
+27 WRITE !!?3,"Building Tasks"
+28 SET DGDIV=0
SET DGDNAM=""
+29 FOR
SET DGDNAM=$ORDER(^DG(40.8,"B",DGDNAM))
if DGDNAM=""
QUIT
SET DGDIV=$ORDER(^DG(40.8,"B",DGDNAM,0))
Begin DoDot:2
+30 ;get station number
SET DGSTN=$$SITE^VASITE($$NOW^XLFDT,DGDIV)
if DGSTN=-1
QUIT
+31 ;get station number
SET DGSTNUM=$PIECE(DGSTN,"^",3)
+32 ;set file name
SET DGFILE="VA"_DGSTNUM_".TXT"
+33 DO TASK(DGFILE,DGPATH,DGDIV)
End DoDot:2
End DoDot:1
QUIT
+34 QUIT
+35 ;
TASK(DGFILE,DGPATH,DGDIV) ; Task off job
+1 NEW ZTSAVE,ZTRTN,ZTDESC,ZTSK,ZTIO,ZX
+2 ;
+3 SET DGPATH=$GET(DGPATH)
+4 if '(DGPATH]"")
SET DGPATH=$$PWD^%ZISH
+5 SET ZX=""
+6 FOR ZX="DGFILE","DGPATH","DGDIV"
SET ZTSAVE(ZX)=""
+7 SET ZTRTN="EN1^DGRUGPRP"
+8 SET ZTDESC="RAI/MDS Patient Demographic Data Collection"
+9 SET ZTIO=""
+10 WRITE !!?5,"Tasking ",DGFILE,"..."
+11 DO ^%ZTLOAD
+12 IF $DATA(ZTSK)[0
WRITE " Task was not queued!",!
+13 IF '$TEST
WRITE !?10,"Task queued: ",ZTSK,!
+14 QUIT
+15 ;
EN1 ; Build HFS file
+1 NEW 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
+2 ;
+3 ; Quit if the tasked job has been asked to stop
if $$S^%ZTLOAD
QUIT
+4 SET DGPATH=$GET(DGPATH)
+5 if '(DGPATH]"")
SET DGPATH=$$PWD^%ZISH
+6 ; Open HFS file device handler
DO OPEN^%ZISH("FILE1",DGPATH,DGFILE,"W")
+7 ; Quit if the device handler did not open properly
if POP
QUIT
+8 USE IO
+9 ;loop thru movement file
SET DGWARD=""
FOR
SET DGWARD=$ORDER(^DGPM("CN",DGWARD))
if DGWARD=""
QUIT
SET DGIEN=0
FOR
SET DGIEN=$ORDER(^DGPM("CN",DGWARD,DGIEN))
if DGIEN'>0
QUIT
Begin DoDot:1
+10 ;get patient ien
SET DFN=$$GET1^DIQ(405,DGIEN,.03,"I")
if DFN=""
QUIT
+11 SET DGRFA=$$GET1^DIQ(405,DGIEN,.11,"I")
+12 SET DGRFA=$SELECT(DGRFA=0:"NSC",DGRFA=1:"SC",1:"")
+13 SET DGEN=$ORDER(^DGEN(27.11,"C",DFN,""),-1)
SET DGENP=""
+14 IF DGEN]""
SET DGENP=$$GET1^DIQ(27.11,DGEN,.07,"I")
+15 ;get patient demographics, inpatient data, and address data
DO DEM^VADPT
DO IN5^VADPT
DO ADD^VADPT
+16 ;get ward ien and ward division
SET DGWIEN=$PIECE(VAIP(5),"^")
if DGWIEN=""
QUIT
SET DGWDIV=$$GET1^DIQ(42,DGWIEN,.015,"I")
+17 ;quit if not rai/mds ward
if $$GET1^DIQ(42,DGWIEN,.035,"I")'=1
QUIT
+18 ;if ward division equal to division being processed continue
IF DGDIV=DGWDIV
Begin DoDot:2
+19 SET DGNAME=VADM(1)
SET DOB=$PIECE(VADM(3),"^")
SET SSN=$PIECE(VADM(2),"^")
SET DGRB=$PIECE(VAIP(6),"^",2)
SET DGMS=$PIECE(VADM(10),"^")
SET SEX=$PIECE(VADM(5),"^")
SET DGRACE=$PIECE(VADM(8),"^")
SET DGSTAB=$SELECT(VAPA(5)]"":$PIECE(^DIC(5,$PIECE(VAPA(5),"^"),0),"^",2),1:"")
+20 ;get admit date/time
SET DGREC=$PIECE(VAIP(13,1),"^")
+21 ;grab date
SET DGADAT=$PIECE($PIECE(DGREC,"^"),".")
+22 ;grab time
SET DGATIME=$PIECE($PIECE(DGREC,"^"),".",2)
+23 ;parse name
SET DGHLNM=$$HLNAME^HLFNC(DGNAME,"^~|\")
IF $PIECE(DGHLNM,"^",4)=""
SET $PIECE(DGHLNM,"^",4)=""
+24 SET DGWREC=DGHLNM_"^"_$EXTRACT(DOB,4,5)_"/"_$EXTRACT(DOB,6,7)_"/"_(1700+$EXTRACT(DOB,1,3))_"^"_SSN_"^"_SEX_"^"_DGMS_"^"_DGRACE_"^"_$EXTRACT(DGADAT,4,5)_"/"_$EXTRACT(DGADAT,6,7)_"/"_(1700+$EXTRACT(DGADAT,1,3))_"@"_DGATIME_"^"
_DGWARD_"/"_DGRB
+25 SET DGWREC=DGWREC_"^"_VAPA(1)_"^"_VAPA(2)_"^"_VAPA(4)_"^"_DGSTAB_"^"_VAPA(6)_"^"_DGENP_"^"_DGRFA
+26 WRITE DGWREC,!
End DoDot:2
End DoDot:1
+27 ; close the HFS file handler
DO CLOSE^%ZISH("FILE1")
+28 QUIT
+29 ;
WARD ;Print Ward/Room/Bed for RAI/MDS wards
+1 ;call device api
DO EN^XUTMDEVQ("RPT^DGRUGPRP","Print Ward/Room/Bed Report","")
+2 DO HOME^%ZIS
+3 QUIT
RPT NEW DGCNT,DGWARD,DGWNAME,DGRB,DGADT,DGRBNM,DGADATE,DGATIME,DGCDT,DGTCNT,DGWCNT
+1 SET (DGTCNT,DGWCNT)=0
+2 ;get current date/time
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET DGCDT=Y
+3 SET DGCNT=0
+4 ;loop through room-bed file, check if ward is rai/mds
SET DGWARD=0
FOR
SET DGWARD=$ORDER(^DG(405.4,"W",DGWARD))
if DGWARD'>0
QUIT
IF $$GET1^DIQ(42,DGWARD,.035,"I")=1
Begin DoDot:1
+5 ;get ward name
SET DGWNAME=$$GET1^DIQ(42,DGWARD,".01","I")
SET DGWCNT=0
+6 ;do header
DO HED
+7 ;loop thru room-bed for this ward
SET DGRB=0
FOR
SET DGRB=$ORDER(^DG(405.4,"W",DGWARD,DGRB))
if DGRB'>0
QUIT
Begin DoDot:2
+8 ;get room-bed name
SET DGRBNM=$$GET1^DIQ(405.4,DGRB,".01","I")
+9 ;add one to ward count
SET DGWCNT=DGWCNT+1
+10 ;if near end of screen, do header
IF $Y+4>$GET(IOSL)
DO HED
+11 ;write room-bed name
WRITE !,?5,DGRBNM
End DoDot:2
+12 ;write ward total and add to grand total
WRITE !!,"Total beds for ward ",DGWNAME,": ",DGWCNT
SET DGTCNT=DGTCNT+DGWCNT
End DoDot:1
+13 ;write grand total
WRITE !!,"Total Beds for all wards: ",DGTCNT
+14 QUIT
HED ;FORM FEED AND PRINT HEADER
+1 IF DGCNT>0
WRITE @IOF
+2 SET DGCNT=1
+3 WRITE !,"RAI/MDS Ward/Room/Beds"
+4 WRITE ?40,DGCDT
+5 WRITE !,"WARD: ",DGWNAME,!
+6 QUIT
