- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGPVREJ.m
r613 r623 1 RGPVREJ ;BIR/PTD-REMOTE PRIMARY VIEW REJECT (PATIENT) ;10/8/06 2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**44,47,53**;30 Apr 99;Build 2 3 ; 4 ;Reference to ^XWB2HL7 supported by IA #3144 5 ;Reference to ^XWBDRPC supported by IA #3149 6 ; 7 REJ ;Option only available for Primary View Reject exceptions 8 ;From within the Exception Handler, for selection, DATA should be defined. 9 N RGBDT,RGICN,RGSITE,PTEN,PELV 10 I DATA="" W !,"No Exception Data available." Q 11 S PTEN=$P(DATA,"^",10) ;IEN IN 991.1 12 S PELV=$P(DATA,"^",11) ;IEN IN 991.12 13 I $P($G(^RGHL7(991.1,PTEN,1,PELV,0)),"^",3)'=234 S VALMSG="Action is ONLY for PRIMARY VIEW REJECT exceptions!" Q 14 I $P($G(^RGHL7(991.1,PTEN,1,PELV,0)),"^",5)=1 S VALMSG="Exception has been PROCESSED; no longer active." Q 15 S RGSITE=$P($$SITE^VASITE(),"^",3) I RGSITE="" W !,"No Site Data defined." Q 16 S RGICN=$P(DATA,"^",6) I RGICN="" W !,"No ICN defined." Q 17 S RGBDT=$P(DATA,"^",3) I RGBDT="" W !,"No Exception Date defined." Q 18 S X=RGBDT D ^%DT S RGBDT=Y ;convert Exception Date from external format to internal 19 ; 20 S VALMBCK="",QUIT=0 21 D FULL^VALM1 22 SEND ;Send a remote query to the MPI for Primary View Reject report 23 N RETURN,RESULT,RGEDT,SNTDT 24 S RGEDT=$$DT^XLFDT ;End date for report internal format 25 NOQ ;No previous query exists for this ICN/exception date 26 I '$D(^XTMP("RGPVREJ"_RGICN,RGBDT)) D RPC G DISP 27 ; 28 OLDQ ;Query already sent for this ICN/ exception date 29 I $D(^XTMP("RGPVREJ"_RGICN,RGBDT)) D 30 .S SNTDT=$$FMTE^XLFDT($P(^XTMP("RGPVREJ"_RGICN,RGBDT),"^",2)) 31 .W !?3,"A query was last sent for this ICN/Exception Date on "_SNTDT 32 .S X=$P(SNTDT,"@") D ^%DT S SNTDT=Y ;convert to internal, strip time 33 .;Has data returned for existing query? 34 .S RETURN(0)=$P(^XTMP("RGPVREJ"_RGICN,RGBDT),"^") 35 .D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) I +RESULT(0)=1 D Q ;Data has returned 36 ..I RGEDT=SNTDT D ;query was sent 'today', want to use that one? 37 ...S DIR("A")=" Do you wish to review that existing query data now? ",DIR(0)="YA" 38 ...S DIR("?")=" Enter YES to review the existing query; NO to send a new query" 39 ...S DIR("B")="YES" D ^DIR K DIR I $D(DIRUT) S QUIT=1 Q ;up-arrowed out 40 ...I Y>0 K DIR Q ;yes, use existing query 41 ...I Y=0 D Q ;no, don't use existing, send new query 42 ....K ^XTMP("RGPVREJ"_RGICN,RGBDT) 43 ....D RPC 44 ....K DIR 45 ....; 46 ..I RGEDT'=SNTDT D ;query was NOT sent 'today', data may be old, send new query 47 ...W !?3,"Previous Query data may be obsolete." 48 ...K ^XTMP("RGPVREJ"_RGICN,RGBDT) 49 ...D RPC 50 .;Data for existing query has NOT returned **47 51 .I +RESULT(0)'=1 D FAIL ;**53 52 ; 53 DISP ;Display Primary View Reject Data 54 I QUIT'=1 D EN^RGEX07(RGICN,RGBDT) 55 EXIT ;Kill variables and quit 56 K CNT,DIR,DIRUT,QUIT,X,Y 57 Q 58 ; 59 RPC ;Send the Remote Query 60 W !?3,"Sending a Remote Query to the Master Patient Index." 61 W !?3,"This will take some time; please be patient." 62 D EN1^XWB2HL7(.RETURN,"200M","RG PRIMARY VIEW REJECT",1,RGSITE,RGICN,RGBDT,RGEDT) I RETURN(0)'="" D Q 63 .S ^XTMP("RGPVREJ"_RGICN,0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"PRIMARY VIEW REJECT" 64 .S ^XTMP("RGPVREJ"_RGICN,RGBDT)=RETURN(0)_"^"_$$NOW^XLFDT 65 .;Has data returned for this query? 66 .S CNT=0 F S CNT=CNT+1 D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) Q:RESULT(0) H 2 I CNT>15 Q ;result(0)=status of handle 67 .I +RESULT(0)=1 W !?3,"Query data has returned from the MPI and is available for review." 68 .I +RESULT(0)'=1 D FAIL ;**53 69 W !!?3,"Problem with Query: ",RETURN(0)_"^"_$G(RETURN(1)) 70 S QUIT=1 71 D PAUSE^VALM1 72 Q 73 ; 74 FAIL ;Status of RPC call - unsuccessful after 30 seconds ;**53 75 W !?3,"Your query request has NOT returned data from the MPI after trying for" 76 W !?3,"30 seconds. This could be due to network issues. Please try again later." 77 K ^XTMP("RGPVREJ"_RGICN,RGBDT) 78 S QUIT=1 79 D PAUSE^VALM1 80 Q 81 ; 1 RGPVREJ ;BIR/PTD-REMOTE PRIMARY VIEW REJECT (PATIENT) ;10/8/06 2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**44,47**;30 Apr 99;Build 10 3 ; 4 ;Reference to ^XWB2HL7 supported by IA #3144 5 ;Reference to ^XWBDRPC supported by IA #3149 6 ; 7 REJ ;Option only available for Primary View Reject exceptions 8 ;From within the Exception Handler, for selection, DATA should be defined. 9 N RGBDT,RGICN,RGSITE,PTEN,PELV 10 I DATA="" W !,"No Exception Data available." Q 11 S PTEN=$P(DATA,"^",10) ;IEN IN 991.1 12 S PELV=$P(DATA,"^",11) ;IEN IN 991.12 13 I $P($G(^RGHL7(991.1,PTEN,1,PELV,0)),"^",3)'=234 S VALMSG="Action is ONLY for PRIMARY VIEW REJECT exceptions!" Q 14 I $P($G(^RGHL7(991.1,PTEN,1,PELV,0)),"^",5)=1 S VALMSG="Exception has been PROCESSED; no longer active." Q 15 S RGSITE=$P($$SITE^VASITE(),"^",3) I RGSITE="" W !,"No Site Data defined." Q 16 S RGICN=$P(DATA,"^",6) I RGICN="" W !,"No ICN defined." Q 17 S RGBDT=$P(DATA,"^",3) I RGBDT="" W !,"No Exception Date defined." Q 18 S X=RGBDT D ^%DT S RGBDT=Y ;convert Exception Date from external format to internal 19 ; 20 S VALMBCK="",QUIT=0 21 D FULL^VALM1 22 SEND ;Send a remote query to the MPI for Primary View Reject report 23 N RETURN,RESULT,RGEDT,SNTDT 24 S RGEDT=$$DT^XLFDT ;End date for report internal format 25 NOQ ;No previous query exists for this ICN/exception date 26 I '$D(^XTMP("RGPVREJ",RGICN,RGBDT)) D RPC G DISP 27 ; 28 OLDQ ;Query already sent for this ICN/ exception date 29 I $D(^XTMP("RGPVREJ",RGICN,RGBDT)) D 30 .S SNTDT=$$FMTE^XLFDT($P(^XTMP("RGPVREJ",RGICN,RGBDT),"^",2)) 31 .W !?3,"A query was last sent for this ICN/Exception Date on "_SNTDT 32 .S X=$P(SNTDT,"@") D ^%DT S SNTDT=Y ;convert to internal, strip time 33 .;Has data returned for existing query? 34 .S RETURN(0)=$P(^XTMP("RGPVREJ",RGICN,RGBDT),"^") 35 .D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) I +RESULT(0)=1 D Q ;Data has returned 36 ..I RGEDT=SNTDT D ;query was sent 'today', want to use that one? 37 ...S DIR("A")=" Do you wish to review that existing query data now? ",DIR(0)="YA" 38 ...S DIR("?")=" Enter YES to review the existing query; NO to send a new query" 39 ...S DIR("B")="YES" D ^DIR K DIR I $D(DIRUT) S QUIT=1 Q ;up-arrowed out 40 ...I Y>0 K DIR Q ;yes, use existing query 41 ...I Y=0 D Q ;no, don't use existing, send new query 42 ....K ^XTMP("RGPVREJ",RGICN,RGBDT) 43 ....D RPC 44 ....K DIR 45 ....; 46 ..I RGEDT'=SNTDT D ;query was NOT sent 'today', data may be old, send new query 47 ...W !?3,"Previous Query data may be obsolete." 48 ...K ^XTMP("RGPVREJ",RGICN,RGBDT) 49 ...D RPC 50 .;Data for existing query has NOT returned **47 51 .I +RESULT(0)'=1 S QUIT=1 W !?3,"Query data has NOT returned from the MPI; please check back later." D PAUSE^VALM1 52 ; 53 DISP ;Display Primary View Reject Data 54 I QUIT'=1 D EN^RGEX07(RGICN,RGBDT) 55 EXIT ;Kill variables and quit 56 K CNT,DIR,DIRUT,QUIT,X,Y 57 Q 58 ; 59 RPC ;Send the Remote Query 60 W !?3,"Sending a Remote Query to the Master Patient Index." 61 W !?3,"This will take some time; please be patient." 62 D EN1^XWB2HL7(.RETURN,"200M","RG PRIMARY VIEW REJECT",1,RGSITE,RGICN,RGBDT,RGEDT) I RETURN(0)'="" D Q 63 .S ^XTMP("RGPVREJ",0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"PRIMARY VIEW REJECT" 64 .S ^XTMP("RGPVREJ",RGICN,RGBDT)=RETURN(0)_"^"_$$NOW^XLFDT 65 .;Has data returned for this query? 66 .S CNT=0 F S CNT=CNT+1 D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) Q:RESULT(0) H 2 I CNT>15 Q ;result(0)=status of handle 67 .I +RESULT(0)=1 W !?3,"Query data has returned from the MPI and is available for review." 68 .I +RESULT(0)'=1 D ;quit, info not back after 30 seconds 69 ..W !?3,"Query data has NOT returned from the MPI; please check back later." 70 ..S QUIT=1 71 ..D PAUSE^VALM1 72 W !!?3,"Problem with Query: ",RETURN(0)_"^"_$G(RETURN(1)) 73 S QUIT=1 74 D PAUSE^VALM1 75 Q 76 ;
Note:
See TracChangeset
for help on using the changeset viewer.
