Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOERPV1

PSOERPV1.m

Go to the documentation of this file.
  1. PSOERPV1 ;BIRM/MFR - eRx Provider Supporting API's ;08/29/22
  1. ;;7.0;OUTPATIENT PHARMACY;**700,746,769**;DEC 1997;Build 26
  1. ;
  1. MATCHSUG(ERXIEN,VIEW) ; Match Suggestion Prompt
  1. ; Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
  1. ; (o)VIEW - View Only Mode (1:YES,0/null: NO)
  1. ;Output: MATCHSUG - VistA Provider (Pointer to #200) or 0 (Not selected or no suggestion on file)
  1. ;
  1. N MATCHSUG,ERXPRV,MATCHCNT,LSTMTCH,LSTERXID,CNT,VPRV,QUIT,ERXID
  1. I '$G(ERXIEN) Q 0
  1. S (MATCHSUG,MATCHCNT,CNT,VPRV,QUIT)=0
  1. S ERXPRV=$$GET1^DIQ(52.49,ERXIEN,2.1,"I") I 'ERXPRV Q 0
  1. F S VPRV=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV)) Q:'VPRV S MATCHCNT=MATCHCNT+1
  1. I MATCHCNT>3 S MATCHCNT=3
  1. F S VPRV=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV)) Q:'VPRV D I MATCHSUG!(CNT>2)!QUIT Q
  1. . S LSTERXID=0,LSTMTCH=9999999 F S LSTMTCH=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,LSTMTCH),-1) Q:'LSTMTCH D I LSTERXID Q
  1. . . S ERXID=$O(^PS(52.49,"APRVVPRV",ERXPRV,VPRV,LSTMTCH,0)) Q:(ERXID=ERXIEN) S LSTERXID=ERXID
  1. . I 'LSTERXID Q
  1. . S CNT=CNT+1
  1. . D CMPPRV(ERXIEN,VPRV,LSTERXID,CNT_"^"_MATCHCNT)
  1. . K DIR S DIR(0)="SOA^"_$S('$G(VIEW):"A:ACCEPT;",1:"")_$S(MATCHCNT>1&(MATCHCNT'=CNT):"N:NEXT;",1:"")_"F:FORGET;E:EXIT"
  1. . S DIR("A")="ACTION on SUGGESTION: "_$S('$G(VIEW):"(A)CCEPT ",1:"")_$S(MATCHCNT>1&(MATCHCNT'=CNT):"(N)EXT ",1:"")_"(F)ORGET (E)XIT: "
  1. . S DIR("B")=$S(MATCHCNT>1&(MATCHCNT'=CNT):"NEXT",1:"EXIT")
  1. . S II=0
  1. . I '$G(VIEW) D
  1. . . S II=II+1,DIR("?",II)=" ACCEPT - Accepts the suggested VistA Provider and matches it to the eRx"
  1. . I MATCHCNT>1&(MATCHCNT'=CNT) D
  1. . . S II=II+1,DIR("?",II)=" NEXT - Ignores this suggested VistA Provider and view the next one"
  1. . S II=II+1,DIR("?",II)=" FORGET - Forgets this suggested VistA Provider so that it is not presented"
  1. . S II=II+1,DIR("?",II)=" again in the future to any user"
  1. . S DIR("?")=" EXIT - Exit and proceed to match the VistA Provider manually"
  1. . D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y="E") S QUIT=1 Q
  1. . I Y="A" S MATCHSUG=VPRV Q
  1. . I Y="N" W ! Q
  1. . I Y="F" D
  1. . . K DIR S DIR(0)="SA^Y:YES;N:NO",DIR("B")="NO"
  1. . . S DIR("A")="Are you sure this validated match should be forgotten? "
  1. . . 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."
  1. . . W ! D ^DIR I $D(DIRUT)!$D(DIROUT)!(Y="N") S VPRV=VPRV-1,CNT=CNT-1 W ! Q
  1. . . W !?50,"Forgetting..." K ^PS(52.49,"APRVVPRV",ERXPRV,VPRV) H 1 W "done." W ! Q
  1. Q MATCHSUG
  1. ;
  1. CMPPRV(ERXIEN,VISTAPRV,LSTERXID,COUNTER) ; Display the Comparison Between eRx and VistA Providers
  1. ;Input: ERXIEN - Pointer to ERX HOLDING QUEUE file (#52.49)
  1. ; VISTAPRV - VistA Provider (Pointer to #2)
  1. ; (o)LSTERXID - Last eRx IEN with the Match (Pointer to #52.49)
  1. ; (o)COUNTER - P1: Entry # | P2: Number of Entries
  1. I '$D(^PS(52.49,+$G(ERXIEN),0))!'$D(^VA(200,+$G(VISTAPRV),0)) Q
  1. N XX,LINE
  1. I $G(LSTERXID) D
  1. . W !?55,"|Sugg. " W $G(IOINHI)_+$G(COUNTER)_$G(IOINORM)_" of "_$G(IOINHI)_$P($G(COUNTER),"^",2)_$G(IOINORM)
  1. . W " - ",$G(IOINHI)_$$FMTE^XLFDT($$GET1^DIQ(52.49,LSTERXID,1.9,"I")\1,"2Z")_$G(IOINORM),"|"
  1. W !,$G(IORVON)_"ERX PROVIDER"_$G(IORVOFF),?41,$G(IORVON)_"VISTA PROVIDER"_$G(IORVOFF)
  1. I $G(LSTERXID) W ?55,"|From eRx#: "_$G(IOINHI)_$$GET1^DIQ(52.49,LSTERXID,.01)_$G(IOINORM),?79,"|"
  1. S $P(XX,"_",81)="" W !,XX
  1. D SETPROV^PSOERUT1("RS",ERXIEN,VISTAPRV)
  1. Q
  1. Q
  1. ;
  1. PRVIDS ; Provider Lookup Identifiers Display (set on DIC("W"))
  1. N Z,Z1,Z2
  1. 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)
  1. I $P(Z1,"^",2)'="" W " DEA#: ",$P(Z1,"^",2) W:$P(Z2,"^",9) " (Exp: "_$$FMTE^XLFDT($P(Z2,"^",9),"2Z")_")"
  1. Q