- MCOREX ;WISC/TJK-OERR/MEDICINE DATA EXTRACT UTILITY ;2/17/98 14:48
- ;;2.3;Medicine;**17**;09/13/1996
- SET S MCK=MCK+1,^TMP("MC",$J,MCC,MCK)=MCM_U_MCHEAD Q
- POINT Q:'$D(^MCAR(MCFILE,MCARGDA,MCNODE))
- S MCM=$P($G(^MCAR(MCFILE,MCARGDA,MCNODE)),U,MCPIECE)
- Q:'MCM S MCM=$P($G(^MCAR(MCFILE1,MCM,0)),U) Q:MCM=""
- D SET
- Q
- MPOINT Q:'$D(^MCAR(MCFILE,MCARGDA,MCNODE))
- F I=0:0 S I=$O(^MCAR(MCFILE,MCARGDA,MCNODE,I)) Q:I'?1N.N D
- .S J=$P(^MCAR(MCFILE,MCARGDA,MCNODE,I,0),U,MCPIECE)
- .Q:'J S MCM=$P($G(^MCAR(MCFILE1,J,0)),U)
- .Q:MCM="" D SET
- Q
- FREE Q:'$D(^MCAR(MCFILE,MCARGDA,MCNODE))
- S MCM=$P(^MCAR(MCFILE,MCARGDA,MCNODE),U,MCPIECE) D SET Q
- MFREE Q:'$D(^MCAR(MCFILE,MCARGDA,MCNODE))
- F I=0:0 S I=$O(^MCAR(MCFILE,MCARGDA,MCNODE,I)) Q:I'?1N.N D
- .S MCM=$P(^MCAR(MCFILE,MCARGDA,MCNODE,I,0),U,MCPIECE)
- .Q:MCM="" D SET
- Q
- SETS Q:'$D(^MCAR(MCFILE,MCARGDA,MCNODE))
- S J=$P(^MCAR(MCFILE,MCARGDA,MCNODE),U,MCPIECE) Q:J=""
- ;S MCM=$P($G(^DD(MCFILE,MCFILE1,0)),U,3) Q:MCM=""
- S MCM=$$GET1^DID(MCFILE,MCFILE1,"","SPECIFIER") Q:MCM=""
- F K=1:1 S L=$P(MCM,";",K) Q:L="" I $P(L,":",1)=J S MCM=$P(L,":",2) D SET Q
- Q
- MSET Q:'$D(^MCAR(MCFILE,MCARGDA,MCNODE))
- F I=0:0 S I=$O(^MCAR(MCFILE,MCARGDA,MCNODE,I)) Q:I'?1N.N D
- .S J=$P(^MCAR(MCFILE,MCARGDA,MCNODE,I,0),U,MCPIECE)
- .;Q:J="" S MCM=$P($G(^DD(MCFILE1,.01,0)),U,3)
- .Q:J="" S MCM=$$GET1^DID(MCFILE1,.01,"","SPECIFIER")
- .F K=1:1 S L=$P(MCM,";",K) Q:L="" I $P(K,":",1)=J S MCM=$P(K,":",2) D SET Q
- Q
- ;
- WP ; word-processing field
- S $P(MCHEAD,";",2)="W" ; indicate to OE/RR that this is WP
- S MCMUP=^DD(MCM,0,"UP")
- S MCMFLD=$O(^DD(MCMUP,"SB",MCM,""))
- ;S MCNODE=+$P(^DD(MCMUP,MCMFLD,0),"^",4)
- S MCNODE=$P($$GET1^DID(MCMUP,MCMFLD,"","GLOBAL SUBSCRIPT LOCATION"),";")
- F I=0:0 S I=$O(^MCAR(MCMUP,MCARGDA,MCNODE,I)) Q:I'?1N.N D
- .S MCM=^MCAR(MCFILE,MCARGDA,MCNODE,I,0)
- .I MCM'="" D SET
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCOREX 1910 printed Feb 18, 2025@23:42:18 Page 2
- MCOREX ;WISC/TJK-OERR/MEDICINE DATA EXTRACT UTILITY ;2/17/98 14:48
- +1 ;;2.3;Medicine;**17**;09/13/1996
- SET SET MCK=MCK+1
- SET ^TMP("MC",$JOB,MCC,MCK)=MCM_U_MCHEAD
- QUIT
- POINT if '$DATA(^MCAR(MCFILE,MCARGDA,MCNODE))
- QUIT
- +1 SET MCM=$PIECE($GET(^MCAR(MCFILE,MCARGDA,MCNODE)),U,MCPIECE)
- +2 if 'MCM
- QUIT
- SET MCM=$PIECE($GET(^MCAR(MCFILE1,MCM,0)),U)
- if MCM=""
- QUIT
- +3 DO SET
- +4 QUIT
- MPOINT if '$DATA(^MCAR(MCFILE,MCARGDA,MCNODE))
- QUIT
- +1 FOR I=0:0
- SET I=$ORDER(^MCAR(MCFILE,MCARGDA,MCNODE,I))
- if I'?1N.N
- QUIT
- Begin DoDot:1
- +2 SET J=$PIECE(^MCAR(MCFILE,MCARGDA,MCNODE,I,0),U,MCPIECE)
- +3 if 'J
- QUIT
- SET MCM=$PIECE($GET(^MCAR(MCFILE1,J,0)),U)
- +4 if MCM=""
- QUIT
- DO SET
- End DoDot:1
- +5 QUIT
- FREE if '$DATA(^MCAR(MCFILE,MCARGDA,MCNODE))
- QUIT
- +1 SET MCM=$PIECE(^MCAR(MCFILE,MCARGDA,MCNODE),U,MCPIECE)
- DO SET
- QUIT
- MFREE if '$DATA(^MCAR(MCFILE,MCARGDA,MCNODE))
- QUIT
- +1 FOR I=0:0
- SET I=$ORDER(^MCAR(MCFILE,MCARGDA,MCNODE,I))
- if I'?1N.N
- QUIT
- Begin DoDot:1
- +2 SET MCM=$PIECE(^MCAR(MCFILE,MCARGDA,MCNODE,I,0),U,MCPIECE)
- +3 if MCM=""
- QUIT
- DO SET
- End DoDot:1
- +4 QUIT
- SETS if '$DATA(^MCAR(MCFILE,MCARGDA,MCNODE))
- QUIT
- +1 SET J=$PIECE(^MCAR(MCFILE,MCARGDA,MCNODE),U,MCPIECE)
- if J=""
- QUIT
- +2 ;S MCM=$P($G(^DD(MCFILE,MCFILE1,0)),U,3) Q:MCM=""
- +3 SET MCM=$$GET1^DID(MCFILE,MCFILE1,"","SPECIFIER")
- if MCM=""
- QUIT
- +4 FOR K=1:1
- SET L=$PIECE(MCM,";",K)
- if L=""
- QUIT
- IF $PIECE(L,":",1)=J
- SET MCM=$PIECE(L,":",2)
- DO SET
- QUIT
- +5 QUIT
- MSET if '$DATA(^MCAR(MCFILE,MCARGDA,MCNODE))
- QUIT
- +1 FOR I=0:0
- SET I=$ORDER(^MCAR(MCFILE,MCARGDA,MCNODE,I))
- if I'?1N.N
- QUIT
- Begin DoDot:1
- +2 SET J=$PIECE(^MCAR(MCFILE,MCARGDA,MCNODE,I,0),U,MCPIECE)
- +3 ;Q:J="" S MCM=$P($G(^DD(MCFILE1,.01,0)),U,3)
- +4 if J=""
- QUIT
- SET MCM=$$GET1^DID(MCFILE1,.01,"","SPECIFIER")
- +5 FOR K=1:1
- SET L=$PIECE(MCM,";",K)
- if L=""
- QUIT
- IF $PIECE(K,":",1)=J
- SET MCM=$PIECE(K,":",2)
- DO SET
- QUIT
- End DoDot:1
- +6 QUIT
- +7 ;
- WP ; word-processing field
- +1 ; indicate to OE/RR that this is WP
- SET $PIECE(MCHEAD,";",2)="W"
- +2 SET MCMUP=^DD(MCM,0,"UP")
- +3 SET MCMFLD=$ORDER(^DD(MCMUP,"SB",MCM,""))
- +4 ;S MCNODE=+$P(^DD(MCMUP,MCMFLD,0),"^",4)
- +5 SET MCNODE=$PIECE($$GET1^DID(MCMUP,MCMFLD,"","GLOBAL SUBSCRIPT LOCATION"),";")
- +6 FOR I=0:0
- SET I=$ORDER(^MCAR(MCMUP,MCARGDA,MCNODE,I))
- if I'?1N.N
- QUIT
- Begin DoDot:1
- +7 SET MCM=^MCAR(MCFILE,MCARGDA,MCNODE,I,0)
- +8 IF MCM'=""
- DO SET
- End DoDot:1
- +9 QUIT
