BQIDCINP ;GDIT/HS/ALA-Find Inpatient Patients ; 06 Nov 2012 3:43 PM
;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
;
Q
;
EN(DATA,PARMS,MPARMS) ;EP
;
;Description
; Executable to retrieve inpatients for the specified parameters
;Input
; PARMS = Array of parameters and their values
; MPARMS = Multiple array of a parameter
;Output
; ^TMP("BQIDCINP",UID,DFN,VISIT IEN)=""
;
NEW UID,AFDT,AEDT,DFDT,DEDT,NXN,IEN,CURINP,ARANGE,DRANGE,RFROM,RTHRU,AFROM,ATHRU
NEW DFROM,DTHRU,LOC,IEN,DFN,NXN,VIEN,VISIT,ATYP,APROV,WARD,DTYP,FTSPEC,CT,MCT
NEW DSDTM,ADTM,NRSE,NURSE
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIDCINP",UID))
S DCRIT=$NA(^TMP("BQICRIT",UID))
K @DATA,@DCRIT
;
; Set the parameters into variables
I '$D(PARMS) Q
;
S NM="" F S NM=$O(PARMS(NM)) Q:NM="" S @NM=PARMS(NM)
S CURINP=$G(CURINP,""),ARANGE=$G(ARANGE,""),AFROM=$G(AFROM,""),ATHRU=$G(ATHRU,""),ATYP=$G(ATYP,"")
S DRANGE=$G(DRANGE,""),DFROM=$G(DFROM,""),DTHRU=$G(DTHRU,""),DTYP=$G(DTYP,""),APROV=$G(APROV,"")
S WARD=$G(WARD,""),FTSPEC=$G(FTSPEC,"")
;
I $G(ARANGE)'="" D
. I $G(PPIEN)'="" D RANGE^BQIDCAH1(ARANGE,PPIEN,"ARANGE")
. S AFDT=$S($G(RFROM)'="":RFROM,1:$G(AFROM))
. S AEDT=$S($G(RTHRU)'="":RTHRU,1:$G(ATHRU))
I $G(AFROM)'="" S AFDT=AFROM,AEDT=$G(ATHRU)
;
I $G(DRANGE)'="" D
. I $G(PPIEN)'="" D RANGE^BQIDCAH1(DRANGE,PPIEN,"DRANGE")
. S DFDT=$S($G(RFROM)'="":RFROM,1:$G(DFROM))
. S DEDT=$S($G(RTHRU)'="":RTHRU,1:$G(DTHRU))
I $G(DFROM)'="" S DFDT=DFROM,DEDT=$G(DTHRU)
;
I $G(CURINP)'="" D
. S LOC=""
. F S LOC=$O(^DGPM("CN",LOC)) Q:LOC="" D
.. S IEN=""
.. F S IEN=$O(^DGPM("CN",LOC,IEN)) Q:IEN="" D
... I $G(^DGPM(IEN,0))="" Q
... S DFN=$P(^DGPM(IEN,0),U,3),$P(@DCRIT@("INP",DFN,IEN),U,1)=1
... S ADTM=$P(^DGPM(IEN,0),U,1)\1
... I $G(AFDT)'="",ADTM<AFDT!(ADTM>AEDT) S $P(@DCRIT@("INP",DFN,IEN),U,1)=0 Q
... D ADM
;
I $G(CURINP)="",$G(AFDT)'="" D
. S AFDT=AFDT-.0001
. F S AFDT=$O(^DGPM("B",AFDT)) Q:AFDT=""!(AFDT\1>AEDT) D
.. S IEN=""
.. F S IEN=$O(^DGPM("B",AFDT,IEN)) Q:IEN="" D
... I $$GET1^DIQ(405,IEN_",",.02,"E")'="ADMISSION" Q
... I $G(^DGPM(IEN,0))="" Q
... S DFN=$P(^DGPM(IEN,0),U,3),$P(@DCRIT@("INP",DFN,IEN),U,1)=1
... D ADM
;
I $G(DFDT)'="" D
. I $D(@DCRIT) D
.. S DFN=""
.. F S DFN=$O(@DCRIT@("INP",DFN)) Q:DFN="" D
... S IEN=""
... F S IEN=$O(@DCRIT@("INP",DFN,IEN)) Q:IEN="" D
.... S NXN="",QFL=0
.... F S NXN=$O(^DGPM("CA",IEN,NXN),-1) Q:NXN=IEN D Q:QFL
..... I $$GET1^DIQ(405,NXN_",",.02,"E")'="DISCHARGE" S $P(@DCRIT@("INP",DFN,IEN),U,6)=0 Q
..... D:$G(DTYP)="" UPD(7,"") D:$G(DTYP)'="" UPD(7,0)
..... I $G(DTYP)'="",$P(^DGPM(IEN,0),U,4)=DTYP D UPD(7,1)
..... S DSDTM=$$GET1^DIQ(405,NXN_",",.01,"I")
..... I DSDTM\1<DFDT!(DSDTM\1>DEDT) S $P(@DCRIT@("INP",DFN,IEN),U,6)=0 Q
..... S $P(@DCRIT@("INP",DFN,IEN),U,6)=1,QFL=1
..... ;D CNF
. I '$D(@DCRIT) D
.. S DFDT=DFDT-.0001
.. F S DFDT=$O(^AUPNVINP("B",DFDT)) Q:DFDT=""!(DFDT\1>DEDT) D
... S VIEN=""
... F S VIEN=$O(^AUPNVINP("B",DFDT,VIEN)) Q:VIEN="" D
.... I $G(^AUPNVINP(VIEN,0))="" Q
.... S VISIT=$P(^AUPNVINP(VIEN,0),U,3),DFN=$P(^(0),U,2)
.... S IEN=$O(^DGPM("AVISIT",VISIT,"")) I IEN="" Q
.... S DFN=$P(^DGPM(IEN,0),U,3),$P(@DCRIT@("INP",DFN,IEN),U,6)=1
.... D ADM,DIS
;
S DFN=""
F S DFN=$O(@DCRIT@("INP",DFN)) Q:DFN="" D
. S IEN=""
. F S IEN=$O(@DCRIT@("INP",DFN,IEN)) Q:IEN="" D CNF
;
Q
;
UPD(PEC,VAL) ;EP
S $P(@DCRIT@("INP",DFN,IEN),U,PEC)=VAL
Q
;
DIS ; EP - Discharge
S NXN=""
F S NXN=$O(^DGPM("CA",IEN,NXN),-1) Q:NXN=IEN D
. I $$GET1^DIQ(405,NXN_",",.02,"E")'="DISCHARGE" Q
. S DFN=$P(^DGPM(IEN,0),U,3),$P(@DCRIT@("INP",DFN,IEN),U,6)=1
. I $G(DTYP)="",'$D(MPARMS("DTYP")) D UPD(7,"")
. I $G(DTYP)'="" D UPD(7,0) I $P(^DGPM(IEN,0),U,4)=DTYP D UPD(7,1)
. I $G(DTYP)="",$D(MPARMS("DTYP")) D
.. S DTYP="" D UPD(7,"")
.. F S DTYP=$O(MPARMS("DTYP",DTYP)) Q:DTYP="" I $P(^DGPM(IEN,0),U,4)=DTYP D UPD(7,1)
. S VISIT=$P(^DGPM(IEN,0),U,27) I VISIT="" Q
. I $G(NURSE)="",'$D(MPARMS("NURSE")) D UPD(8,"")
. S TIEN=""
. F S TIEN=$O(^TIU(8925,"V",VISIT,TIEN)) Q:TIEN="" D
.. I $$GET1^DIQ(8925,TIEN_",",.01,"E")'["NURSE" Q
.. S NRSE=$$GET1^DIQ(8925,TIEN_",",1202,"I") I NRSE="" Q
.. I $G(NURSE)'="" D UPD(8,0) I NURSE=NRSE D UPD(8,1) Q
.. I $G(NURSE)="",$D(MPARMS("NURSE")) D UPD(8,0) I $D(MPARMS("NURSE",NRSE)) D UPD(8,1)
Q
;
CNF ;EP - confirm
S CT=0,MCT=0
F I=1:1:$L(@DCRIT@("INP",DFN,IEN),U) D
. I $P(@DCRIT@("INP",DFN,IEN),U,I)'="" S CT=CT+1
. I $P(@DCRIT@("INP",DFN,IEN),U,I)'="",$P(@DCRIT@("INP",DFN,IEN),U,I)=1 S MCT=MCT+1
I CT=0 K @DCRIT@("INP",DFN,IEN) Q
I CT'=MCT K @DCRIT@("INP",DFN,IEN) Q
I CT=MCT S @DATA@(DFN)=""
Q
;
ADM ;EP - Admission
I $G(ATYP)="",'$D(MPARMS("ATYP")) D UPD(2,"")
I $G(ATYP)'="" D UPD(2,0) I $P(^DGPM(IEN,0),U,4)=ATYP D UPD(2,1)
I $G(ATYP)="",$D(MPARMS("ATYP")) D
. S ATYP="" D UPD(2,0)
. F S ATYP=$O(MPARMS("ATYP",ATYP)) Q:ATYP="" I $P(^DGPM(IEN,0),U,4)=ATYP D UPD(2,1)
I $G(WARD)="",'$D(MPARMS("WARD")) D UPD(3,"")
I $G(WARD)'="" D UPD(3,0) I $P(^DGPM(IEN,0),U,6)=WARD D UPD(3,1)
I $G(WARD)="",$D(MPARMS("WARD")) D
. S WARD="" D UPD(3,0)
. F S WARD=$O(MPARMS("WARD",WARD)) Q:WARD="" I $P(^DGPM(IEN,0),U,6)=WARD D UPD(3,1)
S NXN=$O(^DGPM("CA",IEN,IEN)) I NXN="" Q
I $G(APROV)="",'$D(MPARMS("APROV")) D UPD(4,"")
I $G(APROV)'="" D UPD(4,0) I $P(^DGPM(NXN,0),U,19)=APROV D UPD(4,1)
I $G(APROV)="",$D(MPARMS("APROV")) D
. S APROV="" D UPD(4,0)
. F S APROV=$O(MPARMS("APROV",APROV)) Q:APROV="" I $P(^DGPM(NXN,0),U,19)=APROV D UPD(4,1)
I $G(FTSPEC)="",'$D(MPARMS("FTSPEC")) D UPD(5,"")
I $G(FTSPEC)'="" D UPD(5,0) I $P(^DGPM(NXN,0),U,9)=FTSPEC D UPD(5,1)
I $G(FTSPEC)'="",$D(MPARMS("FTSPEC")) D
. S FTSPEC="" D UPD(5,0)
. F S FTSPEC=$O(MPARMS("FTSPEC",FTSPEC)) Q:FTSPEC="" I $P(^DGPM(NXN,0),U,9)=FTSPEC D UPD(5,1)
Q
BQIDCINP ;GDIT/HS/ALA-Find Inpatient Patients ; 06 Nov 2012 3:43 PM
+1 ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
+2 ;
+3 QUIT
+4 ;
EN(DATA,PARMS,MPARMS) ;EP
+1 ;
+2 ;Description
+3 ; Executable to retrieve inpatients for the specified parameters
+4 ;Input
+5 ; PARMS = Array of parameters and their values
+6 ; MPARMS = Multiple array of a parameter
+7 ;Output
+8 ; ^TMP("BQIDCINP",UID,DFN,VISIT IEN)=""
+9 ;
+10 NEW UID,AFDT,AEDT,DFDT,DEDT,NXN,IEN,CURINP,ARANGE,DRANGE,RFROM,RTHRU,AFROM,ATHRU
+11 NEW DFROM,DTHRU,LOC,IEN,DFN,NXN,VIEN,VISIT,ATYP,APROV,WARD,DTYP,FTSPEC,CT,MCT
+12 NEW DSDTM,ADTM,NRSE,NURSE
+13 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+14 SET DATA=$NAME(^TMP("BQIDCINP",UID))
+15 SET DCRIT=$NAME(^TMP("BQICRIT",UID))
+16 KILL @DATA,@DCRIT
+17 ;
+18 ; Set the parameters into variables
+19 IF '$DATA(PARMS)
QUIT
+20 ;
+21 SET NM=""
FOR
SET NM=$ORDER(PARMS(NM))
IF NM=""
QUIT
SET @NM=PARMS(NM)
+22 SET CURINP=$GET(CURINP,"")
SET ARANGE=$GET(ARANGE,"")
SET AFROM=$GET(AFROM,"")
SET ATHRU=$GET(ATHRU,"")
SET ATYP=$GET(ATYP,"")
+23 SET DRANGE=$GET(DRANGE,"")
SET DFROM=$GET(DFROM,"")
SET DTHRU=$GET(DTHRU,"")
SET DTYP=$GET(DTYP,"")
SET APROV=$GET(APROV,"")
+24 SET WARD=$GET(WARD,"")
SET FTSPEC=$GET(FTSPEC,"")
+25 ;
+26 IF $GET(ARANGE)'=""
Begin DoDot:1
+27 IF $GET(PPIEN)'=""
DO RANGE^BQIDCAH1(ARANGE,PPIEN,"ARANGE")
+28 SET AFDT=$SELECT($GET(RFROM)'="":RFROM,1:$GET(AFROM))
+29 SET AEDT=$SELECT($GET(RTHRU)'="":RTHRU,1:$GET(ATHRU))
End DoDot:1
+30 IF $GET(AFROM)'=""
SET AFDT=AFROM
SET AEDT=$GET(ATHRU)
+31 ;
+32 IF $GET(DRANGE)'=""
Begin DoDot:1
+33 IF $GET(PPIEN)'=""
DO RANGE^BQIDCAH1(DRANGE,PPIEN,"DRANGE")
+34 SET DFDT=$SELECT($GET(RFROM)'="":RFROM,1:$GET(DFROM))
+35 SET DEDT=$SELECT($GET(RTHRU)'="":RTHRU,1:$GET(DTHRU))
End DoDot:1
+36 IF $GET(DFROM)'=""
SET DFDT=DFROM
SET DEDT=$GET(DTHRU)
+37 ;
+38 IF $GET(CURINP)'=""
Begin DoDot:1
+39 SET LOC=""
+40 FOR
SET LOC=$ORDER(^DGPM("CN",LOC))
IF LOC=""
QUIT
Begin DoDot:2
+41 SET IEN=""
+42 FOR
SET IEN=$ORDER(^DGPM("CN",LOC,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+43 IF $GET(^DGPM(IEN,0))=""
QUIT
+44 SET DFN=$PIECE(^DGPM(IEN,0),U,3)
SET $PIECE(@DCRIT@("INP",DFN,IEN),U,1)=1
+45 SET ADTM=$PIECE(^DGPM(IEN,0),U,1)\1
+46 IF $GET(AFDT)'=""
IF ADTM<AFDT!(ADTM>AEDT)
SET $PIECE(@DCRIT@("INP",DFN,IEN),U,1)=0
QUIT
+47 DO ADM
End DoDot:3
End DoDot:2
End DoDot:1
+48 ;
+49 IF $GET(CURINP)=""
IF $GET(AFDT)'=""
Begin DoDot:1
+50 SET AFDT=AFDT-.0001
+51 FOR
SET AFDT=$ORDER(^DGPM("B",AFDT))
IF AFDT=""!(AFDT\1>AEDT)
QUIT
Begin DoDot:2
+52 SET IEN=""
+53 FOR
SET IEN=$ORDER(^DGPM("B",AFDT,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+54 IF $$GET1^DIQ(405,IEN_",",.02,"E")'="ADMISSION"
QUIT
+55 IF $GET(^DGPM(IEN,0))=""
QUIT
+56 SET DFN=$PIECE(^DGPM(IEN,0),U,3)
SET $PIECE(@DCRIT@("INP",DFN,IEN),U,1)=1
+57 DO ADM
End DoDot:3
End DoDot:2
End DoDot:1
+58 ;
+59 IF $GET(DFDT)'=""
Begin DoDot:1
+60 IF $DATA(@DCRIT)
Begin DoDot:2
+61 SET DFN=""
+62 FOR
SET DFN=$ORDER(@DCRIT@("INP",DFN))
IF DFN=""
QUIT
Begin DoDot:3
+63 SET IEN=""
+64 FOR
SET IEN=$ORDER(@DCRIT@("INP",DFN,IEN))
IF IEN=""
QUIT
Begin DoDot:4
+65 SET NXN=""
SET QFL=0
+66 FOR
SET NXN=$ORDER(^DGPM("CA",IEN,NXN),-1)
IF NXN=IEN
QUIT
Begin DoDot:5
+67 IF $$GET1^DIQ(405,NXN_",",.02,"E")'="DISCHARGE"
SET $PIECE(@DCRIT@("INP",DFN,IEN),U,6)=0
QUIT
+68 IF $GET(DTYP)=""
DO UPD(7,"")
IF $GET(DTYP)'=""
DO UPD(7,0)
+69 IF $GET(DTYP)'=""
IF $PIECE(^DGPM(IEN,0),U,4)=DTYP
DO UPD(7,1)
+70 SET DSDTM=$$GET1^DIQ(405,NXN_",",.01,"I")
+71 IF DSDTM\1<DFDT!(DSDTM\1>DEDT)
SET $PIECE(@DCRIT@("INP",DFN,IEN),U,6)=0
QUIT
+72 SET $PIECE(@DCRIT@("INP",DFN,IEN),U,6)=1
SET QFL=1
+73 ;D CNF
End DoDot:5
IF QFL
QUIT
End DoDot:4
End DoDot:3
End DoDot:2
+74 IF '$DATA(@DCRIT)
Begin DoDot:2
+75 SET DFDT=DFDT-.0001
+76 FOR
SET DFDT=$ORDER(^AUPNVINP("B",DFDT))
IF DFDT=""!(DFDT\1>DEDT)
QUIT
Begin DoDot:3
+77 SET VIEN=""
+78 FOR
SET VIEN=$ORDER(^AUPNVINP("B",DFDT,VIEN))
IF VIEN=""
QUIT
Begin DoDot:4
+79 IF $GET(^AUPNVINP(VIEN,0))=""
QUIT
+80 SET VISIT=$PIECE(^AUPNVINP(VIEN,0),U,3)
SET DFN=$PIECE(^(0),U,2)
+81 SET IEN=$ORDER(^DGPM("AVISIT",VISIT,""))
IF IEN=""
QUIT
+82 SET DFN=$PIECE(^DGPM(IEN,0),U,3)
SET $PIECE(@DCRIT@("INP",DFN,IEN),U,6)=1
+83 DO ADM
DO DIS
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+84 ;
+85 SET DFN=""
+86 FOR
SET DFN=$ORDER(@DCRIT@("INP",DFN))
IF DFN=""
QUIT
Begin DoDot:1
+87 SET IEN=""
+88 FOR
SET IEN=$ORDER(@DCRIT@("INP",DFN,IEN))
IF IEN=""
QUIT
DO CNF
End DoDot:1
+89 ;
+90 QUIT
+91 ;
UPD(PEC,VAL) ;EP
+1 SET $PIECE(@DCRIT@("INP",DFN,IEN),U,PEC)=VAL
+2 QUIT
+3 ;
DIS ; EP - Discharge
+1 SET NXN=""
+2 FOR
SET NXN=$ORDER(^DGPM("CA",IEN,NXN),-1)
IF NXN=IEN
QUIT
Begin DoDot:1
+3 IF $$GET1^DIQ(405,NXN_",",.02,"E")'="DISCHARGE"
QUIT
+4 SET DFN=$PIECE(^DGPM(IEN,0),U,3)
SET $PIECE(@DCRIT@("INP",DFN,IEN),U,6)=1
+5 IF $GET(DTYP)=""
IF '$DATA(MPARMS("DTYP"))
DO UPD(7,"")
+6 IF $GET(DTYP)'=""
DO UPD(7,0)
IF $PIECE(^DGPM(IEN,0),U,4)=DTYP
DO UPD(7,1)
+7 IF $GET(DTYP)=""
IF $DATA(MPARMS("DTYP"))
Begin DoDot:2
+8 SET DTYP=""
DO UPD(7,"")
+9 FOR
SET DTYP=$ORDER(MPARMS("DTYP",DTYP))
IF DTYP=""
QUIT
IF $PIECE(^DGPM(IEN,0),U,4)=DTYP
DO UPD(7,1)
End DoDot:2
+10 SET VISIT=$PIECE(^DGPM(IEN,0),U,27)
IF VISIT=""
QUIT
+11 IF $GET(NURSE)=""
IF '$DATA(MPARMS("NURSE"))
DO UPD(8,"")
+12 SET TIEN=""
+13 FOR
SET TIEN=$ORDER(^TIU(8925,"V",VISIT,TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+14 IF $$GET1^DIQ(8925,TIEN_",",.01,"E")'["NURSE"
QUIT
+15 SET NRSE=$$GET1^DIQ(8925,TIEN_",",1202,"I")
IF NRSE=""
QUIT
+16 IF $GET(NURSE)'=""
DO UPD(8,0)
IF NURSE=NRSE
DO UPD(8,1)
QUIT
+17 IF $GET(NURSE)=""
IF $DATA(MPARMS("NURSE"))
DO UPD(8,0)
IF $DATA(MPARMS("NURSE",NRSE))
DO UPD(8,1)
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
CNF ;EP - confirm
+1 SET CT=0
SET MCT=0
+2 FOR I=1:1:$LENGTH(@DCRIT@("INP",DFN,IEN),U)
Begin DoDot:1
+3 IF $PIECE(@DCRIT@("INP",DFN,IEN),U,I)'=""
SET CT=CT+1
+4 IF $PIECE(@DCRIT@("INP",DFN,IEN),U,I)'=""
IF $PIECE(@DCRIT@("INP",DFN,IEN),U,I)=1
SET MCT=MCT+1
End DoDot:1
+5 IF CT=0
KILL @DCRIT@("INP",DFN,IEN)
QUIT
+6 IF CT'=MCT
KILL @DCRIT@("INP",DFN,IEN)
QUIT
+7 IF CT=MCT
SET @DATA@(DFN)=""
+8 QUIT
+9 ;
ADM ;EP - Admission
+1 IF $GET(ATYP)=""
IF '$DATA(MPARMS("ATYP"))
DO UPD(2,"")
+2 IF $GET(ATYP)'=""
DO UPD(2,0)
IF $PIECE(^DGPM(IEN,0),U,4)=ATYP
DO UPD(2,1)
+3 IF $GET(ATYP)=""
IF $DATA(MPARMS("ATYP"))
Begin DoDot:1
+4 SET ATYP=""
DO UPD(2,0)
+5 FOR
SET ATYP=$ORDER(MPARMS("ATYP",ATYP))
IF ATYP=""
QUIT
IF $PIECE(^DGPM(IEN,0),U,4)=ATYP
DO UPD(2,1)
End DoDot:1
+6 IF $GET(WARD)=""
IF '$DATA(MPARMS("WARD"))
DO UPD(3,"")
+7 IF $GET(WARD)'=""
DO UPD(3,0)
IF $PIECE(^DGPM(IEN,0),U,6)=WARD
DO UPD(3,1)
+8 IF $GET(WARD)=""
IF $DATA(MPARMS("WARD"))
Begin DoDot:1
+9 SET WARD=""
DO UPD(3,0)
+10 FOR
SET WARD=$ORDER(MPARMS("WARD",WARD))
IF WARD=""
QUIT
IF $PIECE(^DGPM(IEN,0),U,6)=WARD
DO UPD(3,1)
End DoDot:1
+11 SET NXN=$ORDER(^DGPM("CA",IEN,IEN))
IF NXN=""
QUIT
+12 IF $GET(APROV)=""
IF '$DATA(MPARMS("APROV"))
DO UPD(4,"")
+13 IF $GET(APROV)'=""
DO UPD(4,0)
IF $PIECE(^DGPM(NXN,0),U,19)=APROV
DO UPD(4,1)
+14 IF $GET(APROV)=""
IF $DATA(MPARMS("APROV"))
Begin DoDot:1
+15 SET APROV=""
DO UPD(4,0)
+16 FOR
SET APROV=$ORDER(MPARMS("APROV",APROV))
IF APROV=""
QUIT
IF $PIECE(^DGPM(NXN,0),U,19)=APROV
DO UPD(4,1)
End DoDot:1
+17 IF $GET(FTSPEC)=""
IF '$DATA(MPARMS("FTSPEC"))
DO UPD(5,"")
+18 IF $GET(FTSPEC)'=""
DO UPD(5,0)
IF $PIECE(^DGPM(NXN,0),U,9)=FTSPEC
DO UPD(5,1)
+19 IF $GET(FTSPEC)'=""
IF $DATA(MPARMS("FTSPEC"))
Begin DoDot:1
+20 SET FTSPEC=""
DO UPD(5,0)
+21 FOR
SET FTSPEC=$ORDER(MPARMS("FTSPEC",FTSPEC))
IF FTSPEC=""
QUIT
IF $PIECE(^DGPM(NXN,0),U,9)=FTSPEC
DO UPD(5,1)
End DoDot:1
+22 QUIT
