- PXRMVSCS ;SLC/PKR - Value set code search routines. ;11/21/2014
- ;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291
- ;==========================================
- CODESRCH ;Search all value sets for a specified code.
- N CODE,CSYSIEN,RESULT
- D FULL^VALM1
- S RESULT=$$GETCODE(.CSYSIEN,.CODE)
- I 'RESULT Q
- D CSEARCH(CSYSIEN,CODE)
- S VALMBCK="R"
- Q
- ;
- ;==========================================
- CSEARCH(CSYSIEN,CODE) ;Find all value sets containing the specified code.
- N IND,JND,NL,TEXT,VSIEN,VSL,VSOID,VSNAME,VSVDATE
- S VSNAME=""
- F S VSNAME=$O(^PXRM(802.2,"B",VSNAME)) Q:VSNAME="" D
- . S VSIEN=0
- . F S VSIEN=+$O(^PXRM(802.2,"B",VSNAME,VSIEN)) Q:VSIEN=0 D
- .. I '$D(^PXRM(802.2,VSIEN,2,"B",CSYSIEN)) Q
- .. S IND=$O(^PXRM(802.2,VSIEN,2,"B",CSYSIEN,""))
- .. S JND=0
- .. F S JND=+$O(^PXRM(802.2,VSIEN,2,IND,1,JND)) Q:JND=0 D
- ... I ^PXRM(802.2,VSIEN,2,IND,1,JND,0)=CODE S VSL(VSNAME,VSIEN)=""
- ;Build the output.
- S TEXT(1)="Searching all value sets for the "_$P(^PXRM(802.1,CSYSIEN,0),U,1)_" code "_CODE
- I $D(VSL) S TEXT(2)="It was found in the following value sets:"
- E S TEXT(2)=" It was not found in any value set."
- S VSNAME="",NL=2
- F S VSNAME=$O(VSL(VSNAME)) Q:VSNAME="" D
- . S VSIEN=0
- . F S VSIEN=+$O(VSL(VSNAME,VSIEN)) Q:VSIEN=0 D
- .. S VSOID=$P(^PXRM(802.2,VSIEN,1),U,1)
- .. S VSVDATE=$P(^PXRM(802.2,VSIEN,1),U,3)
- .. S NL=NL+1,TEXT(NL)=""
- .. S NL=NL+1,TEXT(NL)=" "_VSNAME
- .. S NL=NL+1,TEXT(NL)=" OID: "_VSOID
- .. S NL=NL+1,TEXT(NL)=" Version date: "_$$FMTE^XLFDT(VSVDATE)
- .. S NL=NL+1,TEXT(NL)=""
- D BROWSE^DDBR("TEXT","NR","Value Set Code Search")
- Q
- ;
- ;==========================================
- GETCODE(CSYSIEN,CODE) ;Prompt the user for the code to search for.
- N CSIEN,CSNAME,CSVER,DIC,DIR,X,Y
- W !!,"NLM Value Set Coding Systems"
- S CSNAME=""
- F S CSNAME=$O(^PXRM(802.1,"B",CSNAME)) Q:CSNAME="" D
- . S CSIEN=$O(^PXRM(802.1,"B",CSNAME,""))
- . S CSVER=$P(^PXRM(802.1,CSIEN,0),U,3)
- . W !," ",CSNAME," version ",CSVER
- S DIC=802.1,DIC(0)="AE"
- S DIC("A")="Select the coding system: "
- D ^DIC
- S CSYSIEN=$P(Y,U,1)
- I CSYSIEN=-1 Q 0
- S DIR(0)="FAU^3:64"
- S DIR("A")="Input the code: "
- D ^DIR
- S CODE=Y
- I CODE="^" Q 0
- Q 1
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMVSCS 2224 printed Feb 18, 2025@23:16:22 Page 2
- PXRMVSCS ;SLC/PKR - Value set code search routines. ;11/21/2014
- +1 ;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291
- +2 ;==========================================
- CODESRCH ;Search all value sets for a specified code.
- +1 NEW CODE,CSYSIEN,RESULT
- +2 DO FULL^VALM1
- +3 SET RESULT=$$GETCODE(.CSYSIEN,.CODE)
- +4 IF 'RESULT
- QUIT
- +5 DO CSEARCH(CSYSIEN,CODE)
- +6 SET VALMBCK="R"
- +7 QUIT
- +8 ;
- +9 ;==========================================
- CSEARCH(CSYSIEN,CODE) ;Find all value sets containing the specified code.
- +1 NEW IND,JND,NL,TEXT,VSIEN,VSL,VSOID,VSNAME,VSVDATE
- +2 SET VSNAME=""
- +3 FOR
- SET VSNAME=$ORDER(^PXRM(802.2,"B",VSNAME))
- if VSNAME=""
- QUIT
- Begin DoDot:1
- +4 SET VSIEN=0
- +5 FOR
- SET VSIEN=+$ORDER(^PXRM(802.2,"B",VSNAME,VSIEN))
- if VSIEN=0
- QUIT
- Begin DoDot:2
- +6 IF '$DATA(^PXRM(802.2,VSIEN,2,"B",CSYSIEN))
- QUIT
- +7 SET IND=$ORDER(^PXRM(802.2,VSIEN,2,"B",CSYSIEN,""))
- +8 SET JND=0
- +9 FOR
- SET JND=+$ORDER(^PXRM(802.2,VSIEN,2,IND,1,JND))
- if JND=0
- QUIT
- Begin DoDot:3
- +10 IF ^PXRM(802.2,VSIEN,2,IND,1,JND,0)=CODE
- SET VSL(VSNAME,VSIEN)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +11 ;Build the output.
- +12 SET TEXT(1)="Searching all value sets for the "_$PIECE(^PXRM(802.1,CSYSIEN,0),U,1)_" code "_CODE
- +13 IF $DATA(VSL)
- SET TEXT(2)="It was found in the following value sets:"
- +14 IF '$TEST
- SET TEXT(2)=" It was not found in any value set."
- +15 SET VSNAME=""
- SET NL=2
- +16 FOR
- SET VSNAME=$ORDER(VSL(VSNAME))
- if VSNAME=""
- QUIT
- Begin DoDot:1
- +17 SET VSIEN=0
- +18 FOR
- SET VSIEN=+$ORDER(VSL(VSNAME,VSIEN))
- if VSIEN=0
- QUIT
- Begin DoDot:2
- +19 SET VSOID=$PIECE(^PXRM(802.2,VSIEN,1),U,1)
- +20 SET VSVDATE=$PIECE(^PXRM(802.2,VSIEN,1),U,3)
- +21 SET NL=NL+1
- SET TEXT(NL)=""
- +22 SET NL=NL+1
- SET TEXT(NL)=" "_VSNAME
- +23 SET NL=NL+1
- SET TEXT(NL)=" OID: "_VSOID
- +24 SET NL=NL+1
- SET TEXT(NL)=" Version date: "_$$FMTE^XLFDT(VSVDATE)
- +25 SET NL=NL+1
- SET TEXT(NL)=""
- End DoDot:2
- End DoDot:1
- +26 DO BROWSE^DDBR("TEXT","NR","Value Set Code Search")
- +27 QUIT
- +28 ;
- +29 ;==========================================
- GETCODE(CSYSIEN,CODE) ;Prompt the user for the code to search for.
- +1 NEW CSIEN,CSNAME,CSVER,DIC,DIR,X,Y
- +2 WRITE !!,"NLM Value Set Coding Systems"
- +3 SET CSNAME=""
- +4 FOR
- SET CSNAME=$ORDER(^PXRM(802.1,"B",CSNAME))
- if CSNAME=""
- QUIT
- Begin DoDot:1
- +5 SET CSIEN=$ORDER(^PXRM(802.1,"B",CSNAME,""))
- +6 SET CSVER=$PIECE(^PXRM(802.1,CSIEN,0),U,3)
- +7 WRITE !," ",CSNAME," version ",CSVER
- End DoDot:1
- +8 SET DIC=802.1
- SET DIC(0)="AE"
- +9 SET DIC("A")="Select the coding system: "
- +10 DO ^DIC
- +11 SET CSYSIEN=$PIECE(Y,U,1)
- +12 IF CSYSIEN=-1
- QUIT 0
- +13 SET DIR(0)="FAU^3:64"
- +14 SET DIR("A")="Input the code: "
- +15 DO ^DIR
- +16 SET CODE=Y
- +17 IF CODE="^"
- QUIT 0
- +18 QUIT 1
- +19 ;
