- 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 Jan 18, 2025@03:29:01 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