BEHORXED.m

BEHORXED ;MSC/IND/PLS - PharmED Component Support ;06-Nov-2014 10:14;DU

 ;;1.1;BEH COMPONENTS;**044002,044004,044005**;Mar 20, 2007

 ;=========================================================

 ; Return list of selectable POVs

POVLST(DATA) ;EP

 N TMP,LP,POV,NTMP,SNMD,SNMDC,MICD

 ;D GETLST^XPAR(.TMP,"ALL","BEHORXED POV LIST","B")

 ;D GETLST^XPAR(.NTMP,"ALL","BEHORXED POV NARR TEXT","I")

 ;Retrieve SNOMED Concept IDs

 D GETLST^XPAR(.TMP,"ALL","BEHORXED POV SNOMED LIST","B")

 S LP=0 F  S LP=$O(TMP(LP)) Q:'LP  D

 .S SNMD=$G(TMP(LP,"V"))

 .Q:'SNMD

 .;IHS/MSC/MGH Changed to use new API

 .;S SNMDC=$$CONC^BSTSAPI(+SNMD_"^^^1")

 .S SNMDC=$$CONC^AUPNSICD(+SNMD_"^^^1")

 .S MICD=$$GET^XPAR("ALL","BEHORXED POV MAP ICD",LP,"E")

 .Q:$P(SNMDC,U,5)=""&(MICD="")

 .;S DATA(LP)=POV_U_$$GET1^DIQ(80,+POV,3)_U_$G(NTMP(LP))

 .S DATA(LP)=+SNMD_U_$S($L(MICD):MICD,1:$P($P(SNMDC,U,5),";",1))_U_$P(SNMDC,U,4)

 Q

 ; Return list of selectable Education Topics

EDLST(DATA) ;EP

 N TMP,LP,ED

 D GETLST^XPAR(.TMP,"ALL","BEHORXED EDUCATION TOPICS LIST","B")

 S LP=0 F  S LP=$O(TMP(LP)) Q:'LP  D

 .S ED=$G(TMP(LP,"V"))

 .Q:'ED

 .S DATA(LP)=ED

 Q

COMPLST(DATA) ;EP

 N TMP,VAL,SET

 D FIELD^DID(9000010.16,.06,"","POINTER","TMP")

 S SET=$G(TMP("POINTER"))

 I $L(SET) D

 .S LP=1 F  S VAL=$P(SET,";",LP) Q:'VAL  D  S LP=LP+1

 ..S DATA(LP)=VAL

 Q

 ; Store PED data

STORE(DATA,DFN,VSTR,PCCARY) ;EP

 ; PED^Code^Cat^Nar^Com^prv^level of understanding^refused^elapsed^setting^goals^outcome

 N LP

 ;S LP=0 F  S LP=$O(PCCARY(LP)) Q:'LP  D

 ;.I PCCARY(LP)["POV" K PCCARY(LP)

 D SAVE^BEHOENPC(.DATA,.PCCARY)

 D:DATA=0 XTMPSET(DFN,DT)

 Q

 ; Provider Narrative RPC

PRVNRPC(DATA,TXT) ;

 S DATA=$$PRVNARR(TXT)

 Q

 ; Return Provider Narrative IEN

PRVNARR(TXT) ; EP

 N IEN,FDA,IENS,ERR,TRC

 Q:'$L(TXT) ""

 S TXT=$E(TXT,1,80),TRC=$E(TXT,1,30),IEN=0

 F  S IEN=$O(^AUTNPOV("B",TRC,IEN)) Q:'IEN  Q:$P($G(^AUTNPOV(IEN,0)),U)=TXT

 I 'IEN D

 .S FDA(9999999.27,"+1,",.01)=TXT

 .D UPDATE^DIE("","FDA","IENS","ERR")

 .I $G(ERR) S IEN=""

 .E  S IEN=$G(IENS(1))

 Q IEN

 ; Return use status of PharmEd component

CANUSE(DATA,DFN) ;EP

 S DATA='$G(^XTMP("BEHORXED",DT,DFN))

 D CLEANUP(DT)

 Q

 ;

XTMPSET(DFN,DATE) ;EP

 I '$D(^XTMP("BEHORXED",DATE)) D

 .S ^XTMP("BEHORXED",0)=$$FMADD^XLFDT(DT,+7)_U_DT_U_"PharmED component"

 S ^XTMP("BEHORXED",DATE,DFN)=1

 D BRDCAST^CIANBEVT("PCC.PHARMED."_DFN)

 Q

 ; Cleanup the XTMP global

CLEANUP(DATE) ;

 N LP,EDT

 Q:$D(^XTMP("BEHORXED",DATE))  ; already purged

 S EDT=$$FMADD^XLFDT(DATE,-1)

 S LP=0 F  S LP=$O(^XTMP("BEHORXED",LP)) Q:'LP!(LP>EDT)  D

 .K ^XTMP("BEHORXED",LP)

 Q

 ; Return list of available visits

VSTLST(DATA,DFN,SDT,CAT) ;EP

 N EDT,IN,VST,IDT,IDT2,VIEN,NODE0,CNT,LOCNAM,LOCIEN,VDATE,VSTR,STS

 S:'$G(SDT) SDT=DT

 S EDT=SDT+.9

 S CAT=$G(CAT,"A")  ;Default to Ambulatory visits

 S DATA=$$TMPGBL^CIAVMRPC

 S IDT2=9999999-(SDT\1)+.9,IDT=9999999-(EDT\1)

 S CNT=0

 F  Q:'IDT!(IDT>IDT2)  D  S IDT=$O(^AUPNVSIT("AA",DFN,IDT))

 .S VIEN=0 F  S VIEN=$O(^AUPNVSIT("AA",DFN,IDT,VIEN)) Q:'VIEN  D

 ..N PRV

 ..S NODE0=^AUPNVSIT(VIEN,0)

 ..Q:$P(NODE0,U,11)      ; Ignore visits that are logically deleted

 ..Q:$P(NODE0,U,7)'=CAT  ; Compare Service Category

 ..Q:$$ISLOCKED^BEHOENCX(VIEN)  ; Ignore logically deleted visits

 ..S VDATE=+NODE0,LOCIEN=$P(NODE0,U,22),LOCNAM=$$GET1^DIQ(44,LOCIEN,.01)

 ..S VSTR=LOCIEN_";"_VDATE_";"_CAT_";"_VIEN

 ..S STS=$$SET^CIAU(CAT,$P($G(^DD(9000010,.07,0)),U,3))

 ..D GETPRV2^BEHOENCX(.PRV,VIEN,1)

 ..S PRV=$P($G(PRV(+$O(PRV(0)))),U,1,2)

 ..S CNT=CNT+1,@DATA@(-VDATE,CNT)=VSTR_U_LOCNAM_U_VDATE_U_STS_U_U_PRV

 Q

 ; Post-init logic

POST ;EP-

 N OPT

 F OPT="BEHORXED DEFAULT POV","BEHORXED POV LIST","BEHORXED POV NARR TEXT" D OUT^XPDMENU(OPT,"Not currently used."),UPDPAR("SYS",OPT)

 Q

UPDPAR(ENT,PARAM,VAL) ;EP-

 N IEN

 S IEN=$O(^XTV(8989.51,"B",PARAM,0))

 Q:'IEN

 S $P(^XTV(8989.51,IEN,0),U,6)=0

 D:$G(VAL)'="" EN^XPAR(ENT,PARAM,,VAL)

 S $P(^XTV(8989.51,IEN,0),U,6)=1

 Q

BEHORXED  ;MSC/IND/PLS - PharmED Component Support ;06-Nov-2014 10:14;DU

 +1       ;;1.1;BEH COMPONENTS;**044002,044004,044005**;Mar 20, 2007

 +2       ;=========================================================

 +3       ; Return list of selectable POVs

POVLST(DATA) ;EP

 +1        NEW TMP,LP,POV,NTMP,SNMD,SNMDC,MICD

 +2       ;D GETLST^XPAR(.TMP,"ALL","BEHORXED POV LIST","B")

 +3       ;D GETLST^XPAR(.NTMP,"ALL","BEHORXED POV NARR TEXT","I")

 +4       ;Retrieve SNOMED Concept IDs

 +5        DO GETLST^XPAR(.TMP,"ALL","BEHORXED POV SNOMED LIST","B")

 +6        SET LP=0

           FOR 

               SET LP=$ORDER(TMP(LP))

               IF 'LP

                   QUIT 

               Begin DoDot:1

 +7                SET SNMD=$GET(TMP(LP,"V"))

 +8                IF 'SNMD

                       QUIT 

 +9       ;IHS/MSC/MGH Changed to use new API

 +10      ;S SNMDC=$$CONC^BSTSAPI(+SNMD_"^^^1")

 +11               SET SNMDC=$$CONC^AUPNSICD(+SNMD_"^^^1")

 +12               SET MICD=$$GET^XPAR("ALL","BEHORXED POV MAP ICD",LP,"E")

 +13               IF $PIECE(SNMDC,U,5)=""&(MICD="")

                       QUIT 

 +14      ;S DATA(LP)=POV_U_$$GET1^DIQ(80,+POV,3)_U_$G(NTMP(LP))

 +15               SET DATA(LP)=+SNMD_U_$SELECT($LENGTH(MICD):MICD,1:$PIECE($PIECE(SNMDC,U,5),";",1))_U_$PIECE(SNMDC,U,4)

               End DoDot:1

 +16       QUIT 

 +17      ; Return list of selectable Education Topics

EDLST(DATA) ;EP

 +1        NEW TMP,LP,ED

 +2        DO GETLST^XPAR(.TMP,"ALL","BEHORXED EDUCATION TOPICS LIST","B")

 +3        SET LP=0

           FOR 

               SET LP=$ORDER(TMP(LP))

               IF 'LP

                   QUIT 

               Begin DoDot:1

 +4                SET ED=$GET(TMP(LP,"V"))

 +5                IF 'ED

                       QUIT 

 +6                SET DATA(LP)=ED

               End DoDot:1

 +7        QUIT 

COMPLST(DATA) ;EP

 +1        NEW TMP,VAL,SET

 +2        DO FIELD^DID(9000010.16,.06,"","POINTER","TMP")

 +3        SET SET=$GET(TMP("POINTER"))

 +4        IF $LENGTH(SET)

               Begin DoDot:1

 +5                SET LP=1

                   FOR 

                       SET VAL=$PIECE(SET,";",LP)

                       IF 'VAL

                           QUIT 

                       Begin DoDot:2

 +6                        SET DATA(LP)=VAL

                       End DoDot:2

                       SET LP=LP+1

               End DoDot:1

 +7        QUIT 

 +8       ; Store PED data

STORE(DATA,DFN,VSTR,PCCARY) ;EP

 +1       ; PED^Code^Cat^Nar^Com^prv^level of understanding^refused^elapsed^setting^goals^outcome

 +2        NEW LP

 +3       ;S LP=0 F  S LP=$O(PCCARY(LP)) Q:'LP  D

 +4       ;.I PCCARY(LP)["POV" K PCCARY(LP)

 +5        DO SAVE^BEHOENPC(.DATA,.PCCARY)

 +6        IF DATA=0

               DO XTMPSET(DFN,DT)

 +7        QUIT 

 +8       ; Provider Narrative RPC

PRVNRPC(DATA,TXT) ;

 +1        SET DATA=$$PRVNARR(TXT)

 +2        QUIT 

 +3       ; Return Provider Narrative IEN

PRVNARR(TXT) ; EP

 +1        NEW IEN,FDA,IENS,ERR,TRC

 +2        IF '$LENGTH(TXT)

               QUIT ""

 +3        SET TXT=$EXTRACT(TXT,1,80)

           SET TRC=$EXTRACT(TXT,1,30)

           SET IEN=0

 +4        FOR 

               SET IEN=$ORDER(^AUTNPOV("B",TRC,IEN))

               IF 'IEN

                   QUIT 

               IF $PIECE($GET(^AUTNPOV(IEN,0)),U)=TXT

                   QUIT 

 +5        IF 'IEN

               Begin DoDot:1

 +6                SET FDA(9999999.27,"+1,",.01)=TXT

 +7                DO UPDATE^DIE("","FDA","IENS","ERR")

 +8                IF $GET(ERR)

                       SET IEN=""

 +9               IF '$TEST

                       SET IEN=$GET(IENS(1))

               End DoDot:1

 +10       QUIT IEN

 +11      ; Return use status of PharmEd component

CANUSE(DATA,DFN) ;EP

 +1        SET DATA='$GET(^XTMP("BEHORXED",DT,DFN))

 +2        DO CLEANUP(DT)

 +3        QUIT 

 +4       ;

XTMPSET(DFN,DATE) ;EP

 +1        IF '$DATA(^XTMP("BEHORXED",DATE))

               Begin DoDot:1

 +2                SET ^XTMP("BEHORXED",0)=$$FMADD^XLFDT(DT,+7)_U_DT_U_"PharmED component"

               End DoDot:1

 +3        SET ^XTMP("BEHORXED",DATE,DFN)=1

 +4        DO BRDCAST^CIANBEVT("PCC.PHARMED."_DFN)

 +5        QUIT 

 +6       ; Cleanup the XTMP global

CLEANUP(DATE) ;

 +1        NEW LP,EDT

 +2       ; already purged

           IF $DATA(^XTMP("BEHORXED",DATE))

               QUIT 

 +3        SET EDT=$$FMADD^XLFDT(DATE,-1)

 +4        SET LP=0

           FOR 

               SET LP=$ORDER(^XTMP("BEHORXED",LP))

               IF 'LP!(LP>EDT)

                   QUIT 

               Begin DoDot:1

 +5                KILL ^XTMP("BEHORXED",LP)

               End DoDot:1

 +6        QUIT 

 +7       ; Return list of available visits

VSTLST(DATA,DFN,SDT,CAT) ;EP

 +1        NEW EDT,IN,VST,IDT,IDT2,VIEN,NODE0,CNT,LOCNAM,LOCIEN,VDATE,VSTR,STS

 +2        IF '$GET(SDT)

               SET SDT=DT

 +3        SET EDT=SDT+.9

 +4       ;Default to Ambulatory visits

           SET CAT=$GET(CAT,"A")

 +5        SET DATA=$$TMPGBL^CIAVMRPC

 +6        SET IDT2=9999999-(SDT\1)+.9

           SET IDT=9999999-(EDT\1)

 +7        SET CNT=0

 +8        FOR 

               IF 'IDT!(IDT>IDT2)

                   QUIT 

               Begin DoDot:1

 +9                SET VIEN=0

                   FOR 

                       SET VIEN=$ORDER(^AUPNVSIT("AA",DFN,IDT,VIEN))

                       IF 'VIEN

                           QUIT 

                       Begin DoDot:2

 +10                       NEW PRV

 +11                       SET NODE0=^AUPNVSIT(VIEN,0)

 +12      ; Ignore visits that are logically deleted

                           IF $PIECE(NODE0,U,11)

                               QUIT 

 +13      ; Compare Service Category

                           IF $PIECE(NODE0,U,7)'=CAT

                               QUIT 

 +14      ; Ignore logically deleted visits

                           IF $$ISLOCKED^BEHOENCX(VIEN)

                               QUIT 

 +15                       SET VDATE=+NODE0

                           SET LOCIEN=$PIECE(NODE0,U,22)

                           SET LOCNAM=$$GET1^DIQ(44,LOCIEN,.01)

 +16                       SET VSTR=LOCIEN_";"_VDATE_";"_CAT_";"_VIEN

 +17                       SET STS=$$SET^CIAU(CAT,$PIECE($GET(^DD(9000010,.07,0)),U,3))

 +18                       DO GETPRV2^BEHOENCX(.PRV,VIEN,1)

 +19                       SET PRV=$PIECE($GET(PRV(+$ORDER(PRV(0)))),U,1,2)

 +20                       SET CNT=CNT+1

                           SET @DATA@(-VDATE,CNT)=VSTR_U_LOCNAM_U_VDATE_U_STS_U_U_PRV

                       End DoDot:2

               End DoDot:1

               SET IDT=$ORDER(^AUPNVSIT("AA",DFN,IDT))

 +21       QUIT 

 +22      ; Post-init logic

POST      ;EP-

 +1        NEW OPT

 +2        FOR OPT="BEHORXED DEFAULT POV","BEHORXED POV LIST","BEHORXED POV NARR TEXT"

               DO OUT^XPDMENU(OPT,"Not currently used.")

               DO UPDPAR("SYS",OPT)

 +3        QUIT 

UPDPAR(ENT,PARAM,VAL) ;EP-

 +1        NEW IEN

 +2        SET IEN=$ORDER(^XTV(8989.51,"B",PARAM,0))

 +3        IF 'IEN

               QUIT 

 +4        SET $PIECE(^XTV(8989.51,IEN,0),U,6)=0

 +5        IF $GET(VAL)'=""

               DO EN^XPAR(ENT,PARAM,,VAL)

 +6        SET $PIECE(^XTV(8989.51,IEN,0),U,6)=1

 +7        QUIT