BGOSNOP2 ; IHS/MSC/MGH - SNOMED PREFERENCES MANAGER 2 ;07-Apr-2016 07:54;du
;;1.1;BGO COMPONENTS;**13,14,20**;Mar 20, 2007;Build 1
; Clone a preference
; INP = Pref IEN (from) ^ Pref IEN (to)
CLONE(RET,INP) ;EP
N FROM,TO,ITM,SFN,GBL,FNUM,X1
S FNUM=90362.34
K RET
S RET=$$GBLROOT^BGOPFUTL(FNUM,.GBL,.SFN)
Q:RET
I $G(INP)="" S RET=$$ERR^BGOUTL(1008) Q
S FROM=+INP
I 'FROM S RET=$$ERR^BGOUTL(1038) Q
I '$D(@GBL@(FROM,0)) S RET=$$ERR^BGOUTL(1039) Q
S TO=$P(INP,U,2)
I 'TO S RET=$$ERR^BGOUTL(1040) Q
I '$D(@GBL@(TO,0)) S RET=$$ERR^BGOUTL(1041) Q
S ITM=0
F S ITM=$O(@GBL@(FROM,1,ITM)) Q:'ITM D Q:RET
.N FDA,X
.Q:$O(@GBL@(TO,1,"B",ITM,0))
.S X=@GBL@(FROM,1,ITM,0)
.S X1=@GBL@(FROM,1,ITM,1)
.S FDA=$NA(FDA(SFN,"+1,"_TO_","))
.S @FDA@(.01)=+X
.S @FDA@(.02)=$P(X,U,2)
.S @FDA@(.03)=$P(X,U,3)
.S @FDA@(6)=$P(X1,U,1)
.S RET=$$UPDATE^BGOUTL(.FDA,"@")
Q
; Execute query
; INP = Category IEN [1] ^ Provider IEN [2] ^ Clinic IEN [3] ^ Provider Class [4] ^ Hospital Location [5] ^
; Start Date [6] ^ End Date [7] ^ Max Hits [8]
QUERY(RET,INP) ;EP
N CAT,PRV,CLN,CLS,HL,BEGDT,ENDDT,VD,VIEN,VIS,PIEN,DX,ICD,REC,ICD,TXT,CNT,MAX,X
N SNO,DESCT
S RET=""
S CAT=$P(INP,U)
S PRV=$P(INP,U,2)
S CLN=$P(INP,U,3)
S CLS=$P(INP,U,4)
S HL=$P(INP,U,5)
S BEGDT=$P(INP,U,6)
S ENDDT=$P(INP,U,7)
S MAX=+$P(INP,U,8)
I CLN="",CLS="",PRV="",HL="" S RET=$$ERR^BGOUTL(1022) Q
S RET=$$QRYINIT^BGOPFUTL(90362.34,CAT)
Q:RET
S VD=$S(BEGDT:BEGDT,1:DT-20000)
S:'ENDDT ENDDT=DT
S CNT=0
F S VD=$O(^AUPNVSIT("B",VD)) Q:'VD!RET!(VD>ENDDT) D
.S VIEN=0
.S VIEN=$O(^AUPNVSIT("B",VD,VIEN)) Q:'VIEN!RET D
..S VIS=$G(^AUPNVSIT(VIEN,0))
..Q:VIS=""
..I CLN,$P(VIS,U,8)'=CLN Q
..I HL,$P(VIS,U,22)'=HL Q
..I PRV!CLS,'$$VISPRCL^BGOPFUTL(VIEN,PRV,CLS) Q
..S DX=0
..F S DX=$O(^AUPNVPOV("AD",VIEN,DX)) Q:'DX!RET D
...S SNO=$P($G(^AUPNVPOV(DX,11)),U)
...I SNO'="" D
....S CNT=CNT+1
....S DESCT=$P($G(^AUPNVPOV(DX,11)),U,2)
....S:CNT=MAX RET=CNT
....S REC=^AUPNVPOV(DX,0)
....S TXT=$$GET1^DIQ(9000010.07,DX,.04)
....D QRYADD^BGOPFUTL(90362.34,CAT,SNO,TXT)
S RET=$$QRYDONE^BGOPFUTL(90362.34,CAT)
Q
UPDITEM(FNUM,CAT,PTR,CNT,TXT,NEW,ITM) ;EP
N FDA,IEN,GBL,SFN,RET,DESCT,X,IEN,ERR,SNO,TXT2
S RET=$$GBLROOT^BGOPFUTL(FNUM,.GBL,.SFN)
Q:RET RET
S ITM=$S($G(NEW):0,1:$O(@GBL@(CAT,1,"B",PTR,0)))
S:$E($G(CNT))="+" CNT=$S(ITM:$P(@GBL@(CAT,1,ITM,0),U,3),1:0)+CNT
S FDA=$NA(FDA(SFN,$S(ITM:ITM,1:"+1")_","_CAT_","))
;IHS/MSC/MGH use new API
;S X=$$CONC^BSTSAPI(PTR_"^^^1")
S X=$$CONC^AUPNSICD(PTR_"^^^1")
S DESCT=$P(X,U,3),TXT2=$P(X,U,4)
S @FDA@(.01)=PTR
S:$D(CNT) @FDA@(.03)=CNT
S:$G(DESCT) @FDA@(.02)=DESCT
I TXT2'="" S @FDA@(6)=TXT2
;D UPDATE^DIE(,"FDA","IEN","ERR")
;I '$D(ERR),'ITM S ITM=IEN(1)
S RET=$$UPDATE^BGOUTL(.FDA,"E@",.IEN)
I 'RET,'ITM S ITM=IEN(1)
Q RET
UPSTAT(RET,PICK) ;Update status to default on a picklist
N LP,OUT,BGOS,BGODEF,BGOSNO,IN,BGOSNO,BGODEF,DATA,SNODATA,FDA,BGODEF,DEFST
S RET=0,CNT=0
S SFN=90362.342
;Loop through all the SNOMEDS on the picklist
S LP=0 F S LP=$O(^BGOSNOPR(PICK,1,LP)) Q:'+LP D
.S BGOSNO=$P($G(^BGOSNOPR(PICK,1,LP,0)),U,1)
.;get this snomed's default status
.S SNODATA=$$CONC^AUPNSICD(BGOSNO_"^^^1")
.S DEFST=$P(SNODATA,U,9)
.S DEFST=$S(DEFST="Chronic":"A",DEFST="Sub-acute":"S",DEFST="Episodic":"E",DEFST="Social/Environmental":"O",DEFST="Routine/Admin":"R",DEFST="Admin":"R",1:"")
.I DEFST'="" D
..S FDA=$NA(FDA(SFN,LP_","_PICK_","))
..S @FDA@(.06)=DEFST
..S @FDA@(.04)=$$NOW^XLFDT
..S DATA=$$UPDATE^BGOUTL(.FDA,"")
..I 'DATA S CNT=CNT+1
..K DATA
S RET=CNT
Q
SETSUB ;
N X,Y
S X=$$SUBLST^BSTSAPI(OUT,IN)
;SET UP INDEX
S Y=0 F S Y=$O(^TMP($J,BGOS,Y)) Q:Y'=+Y D
.S X=$P(^TMP($J,BGOS,Y),U,1)
.S ^TMP($J,"I",X,BGOS)=""
.Q
Q
UPDATE ;Update all picklist items to default status
N ZTRTN,TSK,ZTDESC
W !,"Update all picklist items to default status",!!
S ZTRTN="OUT^BGOSNOP2"
S ZTDESC="Update picklists to default status"
S TSK=$$QUEUE^CIAUTSK(ZTRTN,ZTDESC,"","","","","")
W !,"Picklist update has scheduled task number: "_TSK
Q
OUT ;Update all subset with default status
N IEN,SIEN,RET,PICK
N LP,OUT,BGOS,BGODEF,BGOSNO,IN,BGOSNO,BGODEF,DATA,SFN,FDA
S RET=0,CNT=0
S SFN=90362.342
S PICK=0
;Loop through the picklists
S IEN=0 F S IEN=$O(^BGOSNOPR(IEN)) Q:'+IEN!(PICK>3) D
.S PICK=PICK+1
. ;Loop through all the SNOMEDS on the picklist
.S LP=0 F S LP=$O(^BGOSNOPR(IEN,1,LP)) Q:'+LP D
..S BGOSNO=$P($G(^BGOSNOPR(IEN,1,LP,0)),U,1)
..;get this snomed's default status
..S SNODATA=$$CONC^AUPNSICD(BGOSNO_"^^^1")
..S DEFST=$P(SNODATA,U,9)
..S DEFST=$S(DEFST="Chronic":"A",DEFST="Sub-acute":"S",DEFST="Episodic":"E",DEFST="Social/Environmental":"O",DEFST="Routine/Admin":"R",DEFST="Admin":"R",1:"")
..I DEFST'="" D
...S FDA=$NA(FDA(SFN,LP_","_IEN_","))
...S @FDA@(.06)=DEFST
...S @FDA@(.04)=$$NOW^XLFDT
...S DATA=$$UPDATE^BGOUTL(.FDA,"")
...I 'DATA S CNT=CNT+1
...K DATA
S RET=CNT
Q
BGOSNOP2 ; IHS/MSC/MGH - SNOMED PREFERENCES MANAGER 2 ;07-Apr-2016 07:54;du
+1 ;;1.1;BGO COMPONENTS;**13,14,20**;Mar 20, 2007;Build 1
+2 ; Clone a preference
+3 ; INP = Pref IEN (from) ^ Pref IEN (to)
CLONE(RET,INP) ;EP
+1 NEW FROM,TO,ITM,SFN,GBL,FNUM,X1
+2 SET FNUM=90362.34
+3 KILL RET
+4 SET RET=$$GBLROOT^BGOPFUTL(FNUM,.GBL,.SFN)
+5 IF RET
QUIT
+6 IF $GET(INP)=""
SET RET=$$ERR^BGOUTL(1008)
QUIT
+7 SET FROM=+INP
+8 IF 'FROM
SET RET=$$ERR^BGOUTL(1038)
QUIT
+9 IF '$DATA(@GBL@(FROM,0))
SET RET=$$ERR^BGOUTL(1039)
QUIT
+10 SET TO=$PIECE(INP,U,2)
+11 IF 'TO
SET RET=$$ERR^BGOUTL(1040)
QUIT
+12 IF '$DATA(@GBL@(TO,0))
SET RET=$$ERR^BGOUTL(1041)
QUIT
+13 SET ITM=0
+14 FOR
SET ITM=$ORDER(@GBL@(FROM,1,ITM))
IF 'ITM
QUIT
Begin DoDot:1
+15 NEW FDA,X
+16 IF $ORDER(@GBL@(TO,1,"B",ITM,0))
QUIT
+17 SET X=@GBL@(FROM,1,ITM,0)
+18 SET X1=@GBL@(FROM,1,ITM,1)
+19 SET FDA=$NAME(FDA(SFN,"+1,"_TO_","))
+20 SET @FDA@(.01)=+X
+21 SET @FDA@(.02)=$PIECE(X,U,2)
+22 SET @FDA@(.03)=$PIECE(X,U,3)
+23 SET @FDA@(6)=$PIECE(X1,U,1)
+24 SET RET=$$UPDATE^BGOUTL(.FDA,"@")
End DoDot:1
IF RET
QUIT
+25 QUIT
+26 ; Execute query
+27 ; INP = Category IEN [1] ^ Provider IEN [2] ^ Clinic IEN [3] ^ Provider Class [4] ^ Hospital Location [5] ^
+28 ; Start Date [6] ^ End Date [7] ^ Max Hits [8]
QUERY(RET,INP) ;EP
+1 NEW CAT,PRV,CLN,CLS,HL,BEGDT,ENDDT,VD,VIEN,VIS,PIEN,DX,ICD,REC,ICD,TXT,CNT,MAX,X
+2 NEW SNO,DESCT
+3 SET RET=""
+4 SET CAT=$PIECE(INP,U)
+5 SET PRV=$PIECE(INP,U,2)
+6 SET CLN=$PIECE(INP,U,3)
+7 SET CLS=$PIECE(INP,U,4)
+8 SET HL=$PIECE(INP,U,5)
+9 SET BEGDT=$PIECE(INP,U,6)
+10 SET ENDDT=$PIECE(INP,U,7)
+11 SET MAX=+$PIECE(INP,U,8)
+12 IF CLN=""
IF CLS=""
IF PRV=""
IF HL=""
SET RET=$$ERR^BGOUTL(1022)
QUIT
+13 SET RET=$$QRYINIT^BGOPFUTL(90362.34,CAT)
+14 IF RET
QUIT
+15 SET VD=$SELECT(BEGDT:BEGDT,1:DT-20000)
+16 IF 'ENDDT
SET ENDDT=DT
+17 SET CNT=0
+18 FOR
SET VD=$ORDER(^AUPNVSIT("B",VD))
IF 'VD!RET!(VD>ENDDT)
QUIT
Begin DoDot:1
+19 SET VIEN=0
+20 SET VIEN=$ORDER(^AUPNVSIT("B",VD,VIEN))
IF 'VIEN!RET
QUIT
Begin DoDot:2
+21 SET VIS=$GET(^AUPNVSIT(VIEN,0))
+22 IF VIS=""
QUIT
+23 IF CLN
IF $PIECE(VIS,U,8)'=CLN
QUIT
+24 IF HL
IF $PIECE(VIS,U,22)'=HL
QUIT
+25 IF PRV!CLS
IF '$$VISPRCL^BGOPFUTL(VIEN,PRV,CLS)
QUIT
+26 SET DX=0
+27 FOR
SET DX=$ORDER(^AUPNVPOV("AD",VIEN,DX))
IF 'DX!RET
QUIT
Begin DoDot:3
+28 SET SNO=$PIECE($GET(^AUPNVPOV(DX,11)),U)
+29 IF SNO'=""
Begin DoDot:4
+30 SET CNT=CNT+1
+31 SET DESCT=$PIECE($GET(^AUPNVPOV(DX,11)),U,2)
+32 IF CNT=MAX
SET RET=CNT
+33 SET REC=^AUPNVPOV(DX,0)
+34 SET TXT=$$GET1^DIQ(9000010.07,DX,.04)
+35 DO QRYADD^BGOPFUTL(90362.34,CAT,SNO,TXT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+36 SET RET=$$QRYDONE^BGOPFUTL(90362.34,CAT)
+37 QUIT
UPDITEM(FNUM,CAT,PTR,CNT,TXT,NEW,ITM) ;EP
+1 NEW FDA,IEN,GBL,SFN,RET,DESCT,X,IEN,ERR,SNO,TXT2
+2 SET RET=$$GBLROOT^BGOPFUTL(FNUM,.GBL,.SFN)
+3 IF RET
QUIT RET
+4 SET ITM=$SELECT($GET(NEW):0,1:$ORDER(@GBL@(CAT,1,"B",PTR,0)))
+5 IF $EXTRACT($GET(CNT))="+"
SET CNT=$SELECT(ITM:$PIECE(@GBL@(CAT,1,ITM,0),U,3),1:0)+CNT
+6 SET FDA=$NAME(FDA(SFN,$SELECT(ITM:ITM,1:"+1")_","_CAT_","))
+7 ;IHS/MSC/MGH use new API
+8 ;S X=$$CONC^BSTSAPI(PTR_"^^^1")
+9 SET X=$$CONC^AUPNSICD(PTR_"^^^1")
+10 SET DESCT=$PIECE(X,U,3)
SET TXT2=$PIECE(X,U,4)
+11 SET @FDA@(.01)=PTR
+12 IF $DATA(CNT)
SET @FDA@(.03)=CNT
+13 IF $GET(DESCT)
SET @FDA@(.02)=DESCT
+14 IF TXT2'=""
SET @FDA@(6)=TXT2
+15 ;D UPDATE^DIE(,"FDA","IEN","ERR")
+16 ;I '$D(ERR),'ITM S ITM=IEN(1)
+17 SET RET=$$UPDATE^BGOUTL(.FDA,"E@",.IEN)
+18 IF 'RET
IF 'ITM
SET ITM=IEN(1)
+19 QUIT RET
UPSTAT(RET,PICK) ;Update status to default on a picklist
+1 NEW LP,OUT,BGOS,BGODEF,BGOSNO,IN,BGOSNO,BGODEF,DATA,SNODATA,FDA,BGODEF,DEFST
+2 SET RET=0
SET CNT=0
+3 SET SFN=90362.342
+4 ;Loop through all the SNOMEDS on the picklist
+5 SET LP=0
FOR
SET LP=$ORDER(^BGOSNOPR(PICK,1,LP))
IF '+LP
QUIT
Begin DoDot:1
+6 SET BGOSNO=$PIECE($GET(^BGOSNOPR(PICK,1,LP,0)),U,1)
+7 ;get this snomed's default status
+8 SET SNODATA=$$CONC^AUPNSICD(BGOSNO_"^^^1")
+9 SET DEFST=$PIECE(SNODATA,U,9)
+10 SET DEFST=$SELECT(DEFST="Chronic":"A",DEFST="Sub-acute":"S",DEFST="Episodic":"E",DEFST="Social/Environmental":"O",DEFST="Routine/Admin":"R",DEFST="Admin":"R",1:"")
+11 IF DEFST'=""
Begin DoDot:2
+12 SET FDA=$NAME(FDA(SFN,LP_","_PICK_","))
+13 SET @FDA@(.06)=DEFST
+14 SET @FDA@(.04)=$$NOW^XLFDT
+15 SET DATA=$$UPDATE^BGOUTL(.FDA,"")
+16 IF 'DATA
SET CNT=CNT+1
+17 KILL DATA
End DoDot:2
End DoDot:1
+18 SET RET=CNT
+19 QUIT
SETSUB ;
+1 NEW X,Y
+2 SET X=$$SUBLST^BSTSAPI(OUT,IN)
+3 ;SET UP INDEX
+4 SET Y=0
FOR
SET Y=$ORDER(^TMP($JOB,BGOS,Y))
IF Y'=+Y
QUIT
Begin DoDot:1
+5 SET X=$PIECE(^TMP($JOB,BGOS,Y),U,1)
+6 SET ^TMP($JOB,"I",X,BGOS)=""
+7 QUIT
End DoDot:1
+8 QUIT
UPDATE ;Update all picklist items to default status
+1 NEW ZTRTN,TSK,ZTDESC
+2 WRITE !,"Update all picklist items to default status",!!
+3 SET ZTRTN="OUT^BGOSNOP2"
+4 SET ZTDESC="Update picklists to default status"
+5 SET TSK=$$QUEUE^CIAUTSK(ZTRTN,ZTDESC,"","","","","")
+6 WRITE !,"Picklist update has scheduled task number: "_TSK
+7 QUIT
OUT ;Update all subset with default status
+1 NEW IEN,SIEN,RET,PICK
+2 NEW LP,OUT,BGOS,BGODEF,BGOSNO,IN,BGOSNO,BGODEF,DATA,SFN,FDA
+3 SET RET=0
SET CNT=0
+4 SET SFN=90362.342
+5 SET PICK=0
+6 ;Loop through the picklists
+7 SET IEN=0
FOR
SET IEN=$ORDER(^BGOSNOPR(IEN))
IF '+IEN!(PICK>3)
QUIT
Begin DoDot:1
+8 SET PICK=PICK+1
+9 ;Loop through all the SNOMEDS on the picklist
+10 SET LP=0
FOR
SET LP=$ORDER(^BGOSNOPR(IEN,1,LP))
IF '+LP
QUIT
Begin DoDot:2
+11 SET BGOSNO=$PIECE($GET(^BGOSNOPR(IEN,1,LP,0)),U,1)
+12 ;get this snomed's default status
+13 SET SNODATA=$$CONC^AUPNSICD(BGOSNO_"^^^1")
+14 SET DEFST=$PIECE(SNODATA,U,9)
+15 SET DEFST=$SELECT(DEFST="Chronic":"A",DEFST="Sub-acute":"S",DEFST="Episodic":"E",DEFST="Social/Environmental":"O",DEFST="Routine/Admin":"R",DEFST="Admin":"R",1:"")
+16 IF DEFST'=""
Begin DoDot:3
+17 SET FDA=$NAME(FDA(SFN,LP_","_IEN_","))
+18 SET @FDA@(.06)=DEFST
+19 SET @FDA@(.04)=$$NOW^XLFDT
+20 SET DATA=$$UPDATE^BGOUTL(.FDA,"")
+21 IF 'DATA
SET CNT=CNT+1
+22 KILL DATA
End DoDot:3
End DoDot:2
End DoDot:1
+23 SET RET=CNT
+24 QUIT
