PSOERPV1 ;BIRM/MFR - eRx Provider Supporting API's ;08/29/22
;;7.0;OUTPATIENT PHARMACY;**700**;DEC 1997;Build 261
;
MATCHSUG(ERXIEN) ; Match Suggestion Prompt
; Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
;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
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 CNT=CNT+1
. S LSTMTCH=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,9999999),-1) I 'LSTMTCH Q
. S LSTERXID=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,LSTMTCH,0)) I 'LSTERXID Q
. D CMPPRV(ERXIEN,VPRV,LSTERXID,CNT_"^"_MATCHCNT)
. K DIR S DIR(0)="SOA^A:ACCEPT;"_$S(MATCHCNT>1&(MATCHCNT'=CNT):"N:NEXT;",1:"")_"F:FORGET;E:EXIT"
. S DIR("A")="ACTION on SUGGESTION: (A)CCEPT "_$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
. 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 3580 printed Apr 09, 2024@21:36:18 Page 2
PSOERPV1 ;BIRM/MFR - eRx Provider Supporting API's ;08/29/22
+1 ;;7.0;OUTPATIENT PHARMACY;**700**;DEC 1997;Build 261
+2 ;
MATCHSUG(ERXIEN) ; Match Suggestion Prompt
+1 ; Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
+2 ;Output: MATCHSUG - VistA Provider (Pointer to #200) or 0 (Not selected or no suggestion on file)
+3 ;
+4 NEW MATCHSUG,ERXPRV,MATCHCNT,LSTMTCH,LSTERXID,CNT,VPRV,QUIT
+5 IF '$GET(ERXIEN)
QUIT 0
+6 SET (MATCHSUG,MATCHCNT,CNT,VPRV,QUIT)=0
+7 SET ERXPRV=$$GET1^DIQ(52.49,ERXIEN,2.1,"I")
IF 'ERXPRV
QUIT 0
+8 FOR
SET VPRV=$ORDER(^PS(52.49,"APRVVPRV",ERXPRV,VPRV))
if 'VPRV
QUIT
SET MATCHCNT=MATCHCNT+1
+9 IF MATCHCNT>3
SET MATCHCNT=3
+10 FOR
SET VPRV=$ORDER(^PS(52.49,"APRVVPRV",ERXPRV,VPRV))
if 'VPRV
QUIT
Begin DoDot:1
+11 SET CNT=CNT+1
+12 SET LSTMTCH=$ORDER(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,9999999),-1)
IF 'LSTMTCH
QUIT
+13 SET LSTERXID=$ORDER(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,LSTMTCH,0))
IF 'LSTERXID
QUIT
+14 DO CMPPRV(ERXIEN,VPRV,LSTERXID,CNT_"^"_MATCHCNT)
+15 KILL DIR
SET DIR(0)="SOA^A:ACCEPT;"_$SELECT(MATCHCNT>1&(MATCHCNT'=CNT):"N:NEXT;",1:"")_"F:FORGET;E:EXIT"
+16 SET DIR("A")="ACTION on SUGGESTION: (A)CCEPT "_$SELECT(MATCHCNT>1&(MATCHCNT'=CNT):"(N)EXT ",1:"")_"(F)ORGET (E)XIT: "
+17 SET DIR("B")=$SELECT(MATCHCNT>1&(MATCHCNT'=CNT):"NEXT",1:"EXIT")
+18 SET II=0
+19 SET II=II+1
SET DIR("?",II)=" ACCEPT - Accepts the suggested VistA Provider and matches it to the eRx"
+20 IF MATCHCNT>1&(MATCHCNT'=CNT)
Begin DoDot:2
+21 SET II=II+1
SET DIR("?",II)=" NEXT - Ignores this suggested VistA Provider and view the next one"
End DoDot:2
+22 SET II=II+1
SET DIR("?",II)=" FORGET - Forgets this suggested VistA Provider so that it is not presented"
+23 SET II=II+1
SET DIR("?",II)=" again in the future to any user"
+24 SET DIR("?")=" EXIT - Exit and proceed to match the VistA Provider manually"
+25 DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)!(Y="E")
SET QUIT=1
QUIT
+26 IF Y="A"
SET MATCHSUG=VPRV
QUIT
+27 IF Y="N"
WRITE !
QUIT
+28 IF Y="F"
Begin DoDot:2
+29 KILL DIR
SET DIR(0)="SA^Y:YES;N:NO"
SET DIR("B")="NO"
+30 SET DIR("A")="Are you sure this validated match should be forgotten? "
+31 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."
+32 WRITE !
DO ^DIR
IF $DATA(DIRUT)!$DATA(DIROUT)!(Y="N")
SET VPRV=VPRV-1
SET CNT=CNT-1
WRITE !
QUIT
+33 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
+34 QUIT MATCHSUG
+35 ;
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
