CIMSNCI1.m

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       ;