PSOERPV1 ;BIRM/MFR - eRx Provider Supporting API's ;08/29/22
;;7.0;OUTPATIENT PHARMACY;**700,746,769**;DEC 1997;Build 26
;
MATCHSUG(ERXIEN,VIEW) ; Match Suggestion Prompt
; Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
; (o)VIEW - View Only Mode (1:YES,0/null: NO)
;Output: MATCHSUG - VistA Provider (Pointer to #200) or 0 (Not selected or no suggestion on file)
;
N MATCHSUG,ERXPRV,MATCHCNT,LSTMTCH,LSTERXID,CNT,VPRV,QUIT,ERXID
I '$G(ERXIEN) Q 0
S (MATCHSUG,MATCHCNT,CNT,VPRV,QUIT)=0
S ERXPRV=$$GET1^DIQ(52.49,ERXIEN,2.1,"I") I 'ERXPRV Q 0
F S VPRV=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV)) Q:'VPRV S MATCHCNT=MATCHCNT+1
I MATCHCNT>3 S MATCHCNT=3
F S VPRV=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV)) Q:'VPRV D I MATCHSUG!(CNT>2)!QUIT Q
. S LSTERXID=0,LSTMTCH=9999999 F S LSTMTCH=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,LSTMTCH),-1) Q:'LSTMTCH D I LSTERXID Q
. . S ERXID=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,LSTMTCH,0)) Q:(ERXID=ERXIEN) S LSTERXID=ERXID
. I 'LSTERXID Q
. S CNT=CNT+1
. D CMPPRV(ERXIEN,VPRV,LSTERXID,CNT_"^"_MATCHCNT)
. K DIR S DIR(0)="SOA^"_$S('$G(VIEW):"A:ACCEPT;",1:"")_$S(MATCHCNT>1&(MATCHCNT'=CNT):"N:NEXT;",1:"")_"F:FORGET;E:EXIT"
. S DIR("A")="ACTION on SUGGESTION: "_$S('$G(VIEW):"(A)CCEPT ",1:"")_$S(MATCHCNT>1&(MATCHCNT'=CNT):"(N)EXT ",1:"")_"(F)ORGET (E)XIT: "
. S DIR("B")=$S(MATCHCNT>1&(MATCHCNT'=CNT):"NEXT",1:"EXIT")
. S II=0
. I '$G(VIEW) D
. . S II=II+1,DIR("?",II)=" ACCEPT - Accepts the suggested VistA Provider and matches it to the eRx"
. I MATCHCNT>1&(MATCHCNT'=CNT) D
. . S II=II+1,DIR("?",II)=" NEXT - Ignores this suggested VistA Provider and view the next one"
. S II=II+1,DIR("?",II)=" FORGET - Forgets this suggested VistA Provider so that it is not presented"
. S II=II+1,DIR("?",II)=" again in the future to any user"
. S DIR("?")=" EXIT - Exit and proceed to match the VistA Provider manually"
. D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y="E") S QUIT=1 Q
. I Y="A" S MATCHSUG=VPRV Q
. I Y="N" W ! Q
. I Y="F" D
. . K DIR S DIR(0)="SA^Y:YES;N:NO",DIR("B")="NO"
. . S DIR("A")="Are you sure this validated match should be forgotten? "
. . S DIR("?")="This VistA Provider was previously matched and validated as a valid match for this eRx Provider. Once you forget this match it will no longer be suggested as a match for this eRx Provider."
. . W ! D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y="N") S VPRV=VPRV-1,CNT=CNT-1 W ! Q
. . W !?50,"Forgetting..." K ^PS(52.49,"APRVVPRV",ERXPRV,VPRV) H 1 W "done." W ! Q
Q MATCHSUG
;
CMPPRV(ERXIEN,VISTAPRV,LSTERXID,COUNTER) ; Display the Comparison Between eRx and VistA Providers
;Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
; VISTAPRV - VistA Provider (Pointer to #2)
; (o)LSTERXID - Last eRx IEN with the Match (Pointer to #52.49)
; (o)COUNTER - P1: Entry # | P2: Number of Entries
I '$D(^PS(52.49,+$G(ERXIEN),0))!'$D(^VA(200,+$G(VISTAPRV),0)) Q
N XX,LINE
I $G(LSTERXID) D
. W !?55,"|Sugg. " W $G(IOINHI)_+$G(COUNTER)_$G(IOINORM)_" of "_$G(IOINHI)_$P($G(COUNTER),"^",2)_$G(IOINORM)
. W " - ",$G(IOINHI)_$$FMTE^XLFDT($$GET1^DIQ(52.49,LSTERXID,1.9,"I")\1,"2Z")_$G(IOINORM),"|"
W !,$G(IORVON)_"ERX PROVIDER"_$G(IORVOFF),?41,$G(IORVON)_"VISTA PROVIDER"_$G(IORVOFF)
I $G(LSTERXID) W ?55,"|From eRx#: "_$G(IOINHI)_$$GET1^DIQ(52.49,LSTERXID,.01)_$G(IOINORM),?79,"|"
S $P(XX,"_",81)="" W !,XX
D SETPROV^PSOERUT1("RS",ERXIEN,VISTAPRV)
Q
Q
;
PRVIDS ; Provider Lookup Identifiers Display (set on DIC("W"))
N Z,Z1,Z2
S Z=$G(^(.11)),Z1=$G(^("PS")),Z2=$G(^("QAR")) I $P(Z,U,4)'="" W " ",$P(Z,U,4) I $P(Z,U,5) W ",",$P(^DIC(5,+$P(Z,U,5),0),U,2)
I $P(Z1,"^",2)'="" W " DEA#: ",$P(Z1,"^",2) W:$P(Z2,"^",9) " (Exp: "_$$FMTE^XLFDT($P(Z2,"^",9),"2Z")_")"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERPV1 3803 printed Dec 13, 2024@02:27:52 Page 2
PSOERPV1 ;BIRM/MFR - eRx Provider Supporting API's ;08/29/22
+1 ;;7.0;OUTPATIENT PHARMACY;**700,746,769**;DEC 1997;Build 26
+2 ;
MATCHSUG(ERXIEN,VIEW) ; Match Suggestion Prompt
+1 ; Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
+2 ; (o)VIEW - View Only Mode (1:YES,0/null: NO)
+3 ;Output: MATCHSUG - VistA Provider (Pointer to #200) or 0 (Not selected or no suggestion on file)
+4 ;
+5 NEW MATCHSUG,ERXPRV,MATCHCNT,LSTMTCH,LSTERXID,CNT,VPRV,QUIT,ERXID
+6 IF '$GET(ERXIEN)
QUIT 0
+7 SET (MATCHSUG,MATCHCNT,CNT,VPRV,QUIT)=0
+8 SET ERXPRV=$$GET1^DIQ(52.49,ERXIEN,2.1,"I")
IF 'ERXPRV
QUIT 0
+9 FOR
SET VPRV=$ORDER(^PS(52.49,"APRVVPRV",ERXPRV,VPRV))
if 'VPRV
QUIT
SET MATCHCNT=MATCHCNT+1
+10 IF MATCHCNT>3
SET MATCHCNT=3
+11 FOR
SET VPRV=$ORDER(^PS(52.49,"APRVVPRV",ERXPRV,VPRV))
if 'VPRV
QUIT
Begin DoDot:1
+12 SET LSTERXID=0
SET LSTMTCH=9999999
FOR
SET LSTMTCH=$ORDER(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,LSTMTCH),-1)
if 'LSTMTCH
QUIT
Begin DoDot:2
+13 SET ERXID=$ORDER(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,LSTMTCH,0))
if (ERXID=ERXIEN)
QUIT
SET LSTERXID=ERXID
End DoDot:2
IF LSTERXID
QUIT
+14 IF 'LSTERXID
QUIT
+15 SET CNT=CNT+1
+16 DO CMPPRV(ERXIEN,VPRV,LSTERXID,CNT_"^"_MATCHCNT)
+17 KILL DIR
SET DIR(0)="SOA^"_$SELECT('$GET(VIEW):"A:ACCEPT;",1:"")_$SELECT(MATCHCNT>1&(MATCHCNT'=CNT):"N:NEXT;",1:"")_"F:FORGET;E:EXIT"
+18 SET DIR("A")="ACTION on SUGGESTION: "_$SELECT('$GET(VIEW):"(A)CCEPT ",1:"")_$SELECT(MATCHCNT>1&(MATCHCNT'=CNT):"(N)EXT ",1:"")_"(F)ORGET (E)XIT: "
+19 SET DIR("B")=$SELECT(MATCHCNT>1&(MATCHCNT'=CNT):"NEXT",1:"EXIT")
+20 SET II=0
+21 IF '$GET(VIEW)
Begin DoDot:2
+22 SET II=II+1
SET DIR("?",II)=" ACCEPT - Accepts the suggested VistA Provider and matches it to the eRx"
End DoDot:2
+23 IF MATCHCNT>1&(MATCHCNT'=CNT)
Begin DoDot:2
+24 SET II=II+1
SET DIR("?",II)=" NEXT - Ignores this suggested VistA Provider and view the next one"
End DoDot:2
+25 SET II=II+1
SET DIR("?",II)=" FORGET - Forgets this suggested VistA Provider so that it is not presented"
+26 SET II=II+1
SET DIR("?",II)=" again in the future to any user"
+27 SET DIR("?")=" EXIT - Exit and proceed to match the VistA Provider manually"
+28 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)!(Y="E")
SET QUIT=1
QUIT
+29 IF Y="A"
SET MATCHSUG=VPRV
QUIT
+30 IF Y="N"
WRITE !
QUIT
+31 IF Y="F"
Begin DoDot:2
+32 KILL DIR
SET DIR(0)="SA^Y:YES;N:NO"
SET DIR("B")="NO"
+33 SET DIR("A")="Are you sure this validated match should be forgotten? "
+34 SET DIR("?")="This VistA Provider was previously matched and validated as a valid match for this eRx Provider. Once you forget this match it will no longer be suggested as a match for this eRx Provider."
+35 WRITE !
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)!(Y="N")
SET VPRV=VPRV-1
SET CNT=CNT-1
WRITE !
QUIT
+36 WRITE !?50,"Forgetting..."
KILL ^PS(52.49,"APRVVPRV",ERXPRV,VPRV)
HANG 1
WRITE "done."
WRITE !
QUIT
End DoDot:2
End DoDot:1
IF MATCHSUG!(CNT>2)!QUIT
QUIT
+37 QUIT MATCHSUG
+38 ;
CMPPRV(ERXIEN,VISTAPRV,LSTERXID,COUNTER) ; Display the Comparison Between eRx and VistA Providers
+1 ;Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
+2 ; VISTAPRV - VistA Provider (Pointer to #2)
+3 ; (o)LSTERXID - Last eRx IEN with the Match (Pointer to #52.49)
+4 ; (o)COUNTER - P1: Entry # | P2: Number of Entries
+5 IF '$DATA(^PS(52.49,+$GET(ERXIEN),0))!'$DATA(^VA(200,+$GET(VISTAPRV),0))
QUIT
+6 NEW XX,LINE
+7 IF $GET(LSTERXID)
Begin DoDot:1
+8 WRITE !?55,"|Sugg. "
WRITE $GET(IOINHI)_+$GET(COUNTER)_$GET(IOINORM)_" of "_$GET(IOINHI)_$PIECE($GET(COUNTER),"^",2)_$GET(IOINORM)
+9 WRITE " - ",$GET(IOINHI)_$$FMTE^XLFDT($$GET1^DIQ(52.49,LSTERXID,1.9,"I")\1,"2Z")_$GET(IOINORM),"|"
End DoDot:1
+10 WRITE !,$GET(IORVON)_"ERX PROVIDER"_$GET(IORVOFF),?41,$GET(IORVON)_"VISTA PROVIDER"_$GET(IORVOFF)
+11 IF $GET(LSTERXID)
WRITE ?55,"|From eRx#: "_$GET(IOINHI)_$$GET1^DIQ(52.49,LSTERXID,.01)_$GET(IOINORM),?79,"|"
+12 SET $PIECE(XX,"_",81)=""
WRITE !,XX
+13 DO SETPROV^PSOERUT1("RS",ERXIEN,VISTAPRV)
+14 QUIT
+15 QUIT
+16 ;
PRVIDS ; Provider Lookup Identifiers Display (set on DIC("W"))
+1 NEW Z,Z1,Z2
+2 SET Z=$GET(^(.11))
SET Z1=$GET(^("PS"))
SET Z2=$GET(^("QAR"))
IF $PIECE(Z,U,4)'=""
WRITE " ",$PIECE(Z,U,4)
IF $PIECE(Z,U,5)
WRITE ",",$PIECE(^DIC(5,+$PIECE(Z,U,5),0),U,2)
+3 IF $PIECE(Z1,"^",2)'=""
WRITE " DEA#: ",$PIECE(Z1,"^",2)
if $PIECE(Z2,"^",9)
WRITE " (Exp: "_$$FMTE^XLFDT($PIECE(Z2,"^",9),"2Z")_")"
+4 QUIT
