- BQISNOMS ;GDHS/HCSD/ALA-SNOMED Subsets ; 19 Dec 2016 1:28 PM
- ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
- ;;
- ;
- SN ;EP - Count entries in each subset
- K ^XTMP("BQISUBS")
- S ^XTMP("BQISUBS",0)=$$FMADD^XLFDT(DT,10)_U_DT_U_"List of SNOMED Subsets"
- S BQILIST=$NA(^TMP("BQISNLST",$J)) K @BQILIST
- D SUBSET^BSTSAPIA(BQILIST,"36^1")
- S BSN=0
- F S BSN=$O(@BQILIST@(BSN)) Q:BSN="" D
- . S BQISBST=$NA(^TMP("BQISNSB",$J)) K @BQISBST
- . S BQISUB=$P(@BQILIST@(BSN),"^",1)
- . S OK=$$SUBLST^BSTSAPI(BQISBST,BQISUB_"^36^1")
- . S BQSN=0,CNT=0
- . F S BQSN=$O(@BQISBST@(BQSN)) Q:BQSN="" S CNT=CNT+1
- . S ^XTMP("BQISUBS",BQISUB)=CNT
- Q
- ;
- LST(DATA,FAKE) ;EP - BQI GET SNOMED SUBSETS
- NEW UID,II,BSN,BQILIST,NUM
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQISNLST",UID))
- K @DATA
- ;
- S II=0
- S HDR="T00075SUBSET^T00010NUM_ITEMS",@DATA@(II)=HDR_$C(30)
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITAXX D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- S BQILIST=$NA(^TMP("BQISLST",UID)) K @BQILIST
- D SUBSET^BSTSAPIA(BQILIST,"36^1")
- S BSN=0
- F S BSN=$O(@BQILIST@(BSN)) Q:BSN="" D
- . S NAME=@BQILIST@(BSN)
- . S NUM=$G(^XTMP("BQISUBS",NAME)) I NUM'<5000 Q
- . I NUM="" Q
- . S II=II+1,@DATA@(II)=NAME_U_" ["_NUM_"]"_$C(30)
- S II=II+1,@DATA@(II)=$C(31)
- Q
- ;
- ITM(DATA,BQISUB) ;EP - BQI GET SNOMED SUBSET ITEMS
- NEW UID,II,BQISBST
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQISNLST",UID))
- K @DATA
- ;
- S II=0
- S HDR="T00100ID^T00245NAME"
- S @DATA@(II)=HDR_$C(30)
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQITAXX D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- S BQISBST=$NA(^TMP("BQISNSB",UID)) K @BQISBST
- S OK=$$SUBLST^BSTSAPI(BQISBST,BQISUB_"^36^1")
- S BQSN=0,CNT=0
- F S BQSN=$O(@BQISBST@(BQSN)) Q:BQSN="" D
- . S CDATA=@BQISBST@(BQSN)
- . S CID=$P(CDATA,"^",1),TXT=$P(CDATA,"^",3)
- . I '$D(^AUPNPROB("ASCT",CID)) S CID="@"_CID
- . S II=II+1,@DATA@(II)=CID_"^"_TXT_$C(30)
- S II=II+1,@DATA@(II)=$C(31)
- Q
- BQISNOMS ;GDHS/HCSD/ALA-SNOMED Subsets ; 19 Dec 2016 1:28 PM
- +1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
- +2 ;;
- +3 ;
- SN ;EP - Count entries in each subset
- +1 KILL ^XTMP("BQISUBS")
- +2 SET ^XTMP("BQISUBS",0)=$$FMADD^XLFDT(DT,10)_U_DT_U_"List of SNOMED Subsets"
- +3 SET BQILIST=$NAME(^TMP("BQISNLST",$JOB))
- KILL @BQILIST
- +4 DO SUBSET^BSTSAPIA(BQILIST,"36^1")
- +5 SET BSN=0
- +6 FOR
- SET BSN=$ORDER(@BQILIST@(BSN))
- IF BSN=""
- QUIT
- Begin DoDot:1
- +7 SET BQISBST=$NAME(^TMP("BQISNSB",$JOB))
- KILL @BQISBST
- +8 SET BQISUB=$PIECE(@BQILIST@(BSN),"^",1)
- +9 SET OK=$$SUBLST^BSTSAPI(BQISBST,BQISUB_"^36^1")
- +10 SET BQSN=0
- SET CNT=0
- +11 FOR
- SET BQSN=$ORDER(@BQISBST@(BQSN))
- IF BQSN=""
- QUIT
- SET CNT=CNT+1
- +12 SET ^XTMP("BQISUBS",BQISUB)=CNT
- End DoDot:1
- +13 QUIT
- +14 ;
- LST(DATA,FAKE) ;EP - BQI GET SNOMED SUBSETS
- +1 NEW UID,II,BSN,BQILIST,NUM
- +2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +3 SET DATA=$NAME(^TMP("BQISNLST",UID))
- +4 KILL @DATA
- +5 ;
- +6 SET II=0
- +7 SET HDR="T00075SUBSET^T00010NUM_ITEMS"
- SET @DATA@(II)=HDR_$CHAR(30)
- +8 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQITAXX D UNWIND^%ZTER"
- +9 SET BQILIST=$NAME(^TMP("BQISLST",UID))
- KILL @BQILIST
- +10 DO SUBSET^BSTSAPIA(BQILIST,"36^1")
- +11 SET BSN=0
- +12 FOR
- SET BSN=$ORDER(@BQILIST@(BSN))
- IF BSN=""
- QUIT
- Begin DoDot:1
- +13 SET NAME=@BQILIST@(BSN)
- +14 SET NUM=$GET(^XTMP("BQISUBS",NAME))
- IF NUM'<5000
- QUIT
- +15 IF NUM=""
- QUIT
- +16 SET II=II+1
- SET @DATA@(II)=NAME_U_" ["_NUM_"]"_$CHAR(30)
- End DoDot:1
- +17 SET II=II+1
- SET @DATA@(II)=$CHAR(31)
- +18 QUIT
- +19 ;
- ITM(DATA,BQISUB) ;EP - BQI GET SNOMED SUBSET ITEMS
- +1 NEW UID,II,BQISBST
- +2 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +3 SET DATA=$NAME(^TMP("BQISNLST",UID))
- +4 KILL @DATA
- +5 ;
- +6 SET II=0
- +7 SET HDR="T00100ID^T00245NAME"
- +8 SET @DATA@(II)=HDR_$CHAR(30)
- +9 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQITAXX D UNWIND^%ZTER"
- +10 SET BQISBST=$NAME(^TMP("BQISNSB",UID))
- KILL @BQISBST
- +11 SET OK=$$SUBLST^BSTSAPI(BQISBST,BQISUB_"^36^1")
- +12 SET BQSN=0
- SET CNT=0
- +13 FOR
- SET BQSN=$ORDER(@BQISBST@(BQSN))
- IF BQSN=""
- QUIT
- Begin DoDot:1
- +14 SET CDATA=@BQISBST@(BQSN)
- +15 SET CID=$PIECE(CDATA,"^",1)
- SET TXT=$PIECE(CDATA,"^",3)
- +16 IF '$DATA(^AUPNPROB("ASCT",CID))
- SET CID="@"_CID
- +17 SET II=II+1
- SET @DATA@(II)=CID_"^"_TXT_$CHAR(30)
- End DoDot:1
- +18 SET II=II+1
- SET @DATA@(II)=$CHAR(31)
- +19 QUIT
