CIMSNCI1 ; CMI/TUCSON/LAB - NCI RECORD GENERATION ;
;;1.0;NCI STUDY EXTRACT 1.0;;MAY 14, 1998
;
;
AREC(DFN,CIMSDDX,CIMSRTYP) ;PEP - called to send back a visit record as
NEW CIMSREC,CIMSX,CIMS
S CIMSREC=""
I '$G(DFN) Q CIMSREC
I '$D(^DPT(DFN)) Q CIMSREC
I '$D(^AUPNPAT(DFN,0)) Q CIMSREC
I '$D(^CIMSCPAT(DFN)) Q CIMSREC
S CIMSRTYP("IEN")=$O(^CIMSCREC("B",CIMSRTYP,0))
I 'CIMSRTYP("IEN") Q CIMSREC
X:$G(^CIMSCREC(CIMSRTYP("IEN"),12))]"" ^CIMSCREC(CIMSRTYP("IEN"),12)
PROC ;
S CIMSX=0
F S CIMSX=$O(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX)) Q:CIMSX'=+CIMSX!(CIMSREC=-1) S CIMS=$O(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX,0)) D
.S X="" X:$D(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11)) ^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11)
.S $E(CIMSREC,$P(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,0),U,2))=X
Q CIMSREC
;
BREC(CIMSV,CIMSRTYP) ;PEP
NEW CIMSREC,CIMSX,CIMS
S CIMSREC=""
I '$G(CIMSV) Q CIMSREC
I '$D(^AUPNVSIT(CIMSV)) Q CIMSREC
NEW CIMSDFN S CIMSDFN=$P(^AUPNVSIT(CIMSV,0),U,5)
S CIMSRTYP("IEN")=$O(^CIMSCREC("B",CIMSRTYP,0))
I 'CIMSRTYP("IEN") Q CIMSREC
X:$G(^CIMSCREC(CIMSRTYP("IEN"),12))]"" ^CIMSCREC(CIMSRTYP("IEN"),12)
BPROC ;
S CIMSX=0
F S CIMSX=$O(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX)) Q:CIMSX'=+CIMSX!(CIMSREC=-1) S CIMS=$O(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX,0)) D
.S X="" X:$D(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11)) ^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11)
.S $E(CIMSREC,$P(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,0),U,2))=X
Q CIMSREC
;
LREC(CIMSLAB,CIMSRTYP) ;PEP
NEW CIMSREC,CIMSX,CIMS
S CIMSREC=""
I '$G(CIMSLAB) Q CIMSREC
I '$D(^AUPNVLAB(CIMSLAB)) Q CIMSREC
NEW CIMSVDFN S CIMSVDFN=$P(^AUPNVLAB(CIMSLAB,0),U,3)
NEW CIMSDFN S CIMSDFN=$P(^AUPNVLAB(CIMSLAB,0),U,2)
S CIMSRTYP("IEN")=$O(^CIMSCREC("B",CIMSRTYP,0))
I 'CIMSRTYP("IEN") Q CIMSREC
X:$G(^CIMSCREC(CIMSRTYP("IEN"),12))]"" ^CIMSCREC(CIMSRTYP("IEN"),12)
LPROC ;
S CIMSX=0
F S CIMSX=$O(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX)) Q:CIMSX'=+CIMSX!(CIMSREC=-1) S CIMS=$O(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX,0)) D
.S X="" X:$D(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11)) ^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11)
.S $E(CIMSREC,$P(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,0),U,2))=X
Q CIMSREC
;
MREC(CIMSMED,CIMSRTYP) ;PEP
NEW CIMSREC,CIMSX,CIMS
S CIMSREC=""
I '$G(CIMSMED) Q CIMSREC
I '$D(^AUPNVMED(CIMSMED)) Q CIMSREC
NEW CIMSVDFN S CIMSVDFN=$P(^AUPNVMED(CIMSMED,0),U,3)
NEW CIMSDFN S CIMSDFN=$P(^AUPNVMED(CIMSMED,0),U,2)
S CIMSRTYP("IEN")=$O(^CIMSCREC("B",CIMSRTYP,0))
I 'CIMSRTYP("IEN") Q CIMSREC
X:$G(^CIMSCREC(CIMSRTYP("IEN"),12))]"" ^CIMSCREC(CIMSRTYP("IEN"),12)
MPROC ;
S CIMSX=0
F S CIMSX=$O(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX)) Q:CIMSX'=+CIMSX!(CIMSREC=-1) S CIMS=$O(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX,0)) D
.S X="" X:$D(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11)) ^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11)
.S $E(CIMSREC,$P(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,0),U,2))=X
Q CIMSREC
;
PREC(CIMSPRB,CIMSRTYP) ;
NEW CIMSREC,CIMSX,CIMS
S CIMSREC=""
I '$G(CIMSPRB) Q CIMSREC
I '$D(^AUPNPROB(CIMSPRB)) Q CIMSREC
NEW CIMSDFN S CIMSDFN=$P(^AUPNPROB(CIMSPRB,0),U,2)
S CIMSRTYP("IEN")=$O(^CIMSCREC("B",CIMSRTYP,0))
I 'CIMSRTYP("IEN") Q CIMSREC
X:$G(^CIMSCREC(CIMSRTYP("IEN"),12))]"" ^CIMSCREC(CIMSRTYP("IEN"),12)
PPROC ;
S CIMSX=0 F S CIMSX=$O(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX)) Q:CIMSX'=+CIMSX!(CIMSREC=-1) S CIMS=$O(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX,0)) D
.S X="" X:$D(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11)) ^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11)
.S $E(CIMSREC,$P(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,0),U,2))=X
Q CIMSREC
;
CIMSNCI1 ; CMI/TUCSON/LAB - NCI RECORD GENERATION ;
+1 ;;1.0;NCI STUDY EXTRACT 1.0;;MAY 14, 1998
+2 ;
+3 ;
AREC(DFN,CIMSDDX,CIMSRTYP) ;PEP - called to send back a visit record as
+1 NEW CIMSREC,CIMSX,CIMS
+2 SET CIMSREC=""
+3 IF '$GET(DFN)
QUIT CIMSREC
+4 IF '$DATA(^DPT(DFN))
QUIT CIMSREC
+5 IF '$DATA(^AUPNPAT(DFN,0))
QUIT CIMSREC
+6 IF '$DATA(^CIMSCPAT(DFN))
QUIT CIMSREC
+7 SET CIMSRTYP("IEN")=$ORDER(^CIMSCREC("B",CIMSRTYP,0))
+8 IF 'CIMSRTYP("IEN")
QUIT CIMSREC
+9 IF $GET(^CIMSCREC(CIMSRTYP("IEN"),12))]""
XECUTE ^CIMSCREC(CIMSRTYP("IEN"),12)
PROC ;
+1 SET CIMSX=0
+2 FOR
SET CIMSX=$ORDER(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX))
IF CIMSX'=+CIMSX!(CIMSREC=-1)
QUIT
SET CIMS=$ORDER(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX,0))
Begin DoDot:1
+3 SET X=""
IF $DATA(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11))
XECUTE ^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11)
+4 SET $EXTRACT(CIMSREC,$PIECE(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,0),U,2))=X
End DoDot:1
+5 QUIT CIMSREC
+6 ;
BREC(CIMSV,CIMSRTYP) ;PEP
+1 NEW CIMSREC,CIMSX,CIMS
+2 SET CIMSREC=""
+3 IF '$GET(CIMSV)
QUIT CIMSREC
+4 IF '$DATA(^AUPNVSIT(CIMSV))
QUIT CIMSREC
+5 NEW CIMSDFN
SET CIMSDFN=$PIECE(^AUPNVSIT(CIMSV,0),U,5)
+6 SET CIMSRTYP("IEN")=$ORDER(^CIMSCREC("B",CIMSRTYP,0))
+7 IF 'CIMSRTYP("IEN")
QUIT CIMSREC
+8 IF $GET(^CIMSCREC(CIMSRTYP("IEN"),12))]""
XECUTE ^CIMSCREC(CIMSRTYP("IEN"),12)
BPROC ;
+1 SET CIMSX=0
+2 FOR
SET CIMSX=$ORDER(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX))
IF CIMSX'=+CIMSX!(CIMSREC=-1)
QUIT
SET CIMS=$ORDER(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX,0))
Begin DoDot:1
+3 SET X=""
IF $DATA(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11))
XECUTE ^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11)
+4 SET $EXTRACT(CIMSREC,$PIECE(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,0),U,2))=X
End DoDot:1
+5 QUIT CIMSREC
+6 ;
LREC(CIMSLAB,CIMSRTYP) ;PEP
+1 NEW CIMSREC,CIMSX,CIMS
+2 SET CIMSREC=""
+3 IF '$GET(CIMSLAB)
QUIT CIMSREC
+4 IF '$DATA(^AUPNVLAB(CIMSLAB))
QUIT CIMSREC
+5 NEW CIMSVDFN
SET CIMSVDFN=$PIECE(^AUPNVLAB(CIMSLAB,0),U,3)
+6 NEW CIMSDFN
SET CIMSDFN=$PIECE(^AUPNVLAB(CIMSLAB,0),U,2)
+7 SET CIMSRTYP("IEN")=$ORDER(^CIMSCREC("B",CIMSRTYP,0))
+8 IF 'CIMSRTYP("IEN")
QUIT CIMSREC
+9 IF $GET(^CIMSCREC(CIMSRTYP("IEN"),12))]""
XECUTE ^CIMSCREC(CIMSRTYP("IEN"),12)
LPROC ;
+1 SET CIMSX=0
+2 FOR
SET CIMSX=$ORDER(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX))
IF CIMSX'=+CIMSX!(CIMSREC=-1)
QUIT
SET CIMS=$ORDER(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX,0))
Begin DoDot:1
+3 SET X=""
IF $DATA(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11))
XECUTE ^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11)
+4 SET $EXTRACT(CIMSREC,$PIECE(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,0),U,2))=X
End DoDot:1
+5 QUIT CIMSREC
+6 ;
MREC(CIMSMED,CIMSRTYP) ;PEP
+1 NEW CIMSREC,CIMSX,CIMS
+2 SET CIMSREC=""
+3 IF '$GET(CIMSMED)
QUIT CIMSREC
+4 IF '$DATA(^AUPNVMED(CIMSMED))
QUIT CIMSREC
+5 NEW CIMSVDFN
SET CIMSVDFN=$PIECE(^AUPNVMED(CIMSMED,0),U,3)
+6 NEW CIMSDFN
SET CIMSDFN=$PIECE(^AUPNVMED(CIMSMED,0),U,2)
+7 SET CIMSRTYP("IEN")=$ORDER(^CIMSCREC("B",CIMSRTYP,0))
+8 IF 'CIMSRTYP("IEN")
QUIT CIMSREC
+9 IF $GET(^CIMSCREC(CIMSRTYP("IEN"),12))]""
XECUTE ^CIMSCREC(CIMSRTYP("IEN"),12)
MPROC ;
+1 SET CIMSX=0
+2 FOR
SET CIMSX=$ORDER(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX))
IF CIMSX'=+CIMSX!(CIMSREC=-1)
QUIT
SET CIMS=$ORDER(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX,0))
Begin DoDot:1
+3 SET X=""
IF $DATA(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11))
XECUTE ^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11)
+4 SET $EXTRACT(CIMSREC,$PIECE(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,0),U,2))=X
End DoDot:1
+5 QUIT CIMSREC
+6 ;
PREC(CIMSPRB,CIMSRTYP) ;
+1 NEW CIMSREC,CIMSX,CIMS
+2 SET CIMSREC=""
+3 IF '$GET(CIMSPRB)
QUIT CIMSREC
+4 IF '$DATA(^AUPNPROB(CIMSPRB))
QUIT CIMSREC
+5 NEW CIMSDFN
SET CIMSDFN=$PIECE(^AUPNPROB(CIMSPRB,0),U,2)
+6 SET CIMSRTYP("IEN")=$ORDER(^CIMSCREC("B",CIMSRTYP,0))
+7 IF 'CIMSRTYP("IEN")
QUIT CIMSREC
+8 IF $GET(^CIMSCREC(CIMSRTYP("IEN"),12))]""
XECUTE ^CIMSCREC(CIMSRTYP("IEN"),12)
PPROC ;
+1 SET CIMSX=0
FOR
SET CIMSX=$ORDER(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX))
IF CIMSX'=+CIMSX!(CIMSREC=-1)
QUIT
SET CIMS=$ORDER(^CIMSCREC(CIMSRTYP("IEN"),11,"AC",CIMSX,0))
Begin DoDot:1
+2 SET X=""
IF $DATA(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11))
XECUTE ^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,11)
+3 SET $EXTRACT(CIMSREC,$PIECE(^CIMSCREC(CIMSRTYP("IEN"),11,CIMS,0),U,2))=X
End DoDot:1
+4 QUIT CIMSREC
+5 ;
