source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSSCRU1.m@ 975

Last change on this file since 975 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1BPSSCRU1 ;BHAM ISC/SS - ECME SCREEN UTILITIES ;05-APR-05
2 ;;1.0;E CLAIMS MGMT ENGINE;**1**;JUN 2004
3 ;; Per VHA Directive 10-93-142, this routine should not be modified.
4 ;USER SCREEN
5 Q
6 ;
7 ;get date/time range
8 ;input:
9 ; BPROF - to store usre profile info
10 ;output:
11 ; BPROF("BDT") - start datetime in FM format
12 ; BPROF("EDT") - end datetime in FM format
13GETDT(BPROF) ;
14 N BPNOW,X,BPHORL,%
15 D NOW^%DTC S BPNOW=%
16 I ($G(BPROF(1.04))'="D")&($G(BPROF(1.04))'="H") S BPROF(1.04)="D"
17 I +$G(BPROF(1.05))=0 S BPROF(1.05)=1
18 I $G(BPROF(1.04))="D" D
19 . S BPROF("BDT")=$$FMADD^XLFDT(BPNOW\1,-$G(BPROF(1.05)))-0.000001
20 . S BPROF("EDT")=(BPNOW\1)+0.9
21 I $G(BPROF(1.04))="H" D
22 . S BPROF("BDT")=$$FMADD^XLFDT(BPNOW,0,-$G(BPROF(1.05)))
23 . S BPROF("EDT")=BPNOW
24 Q 1
25 ;
26 ;
27ISCOPAY ;stub
28 Q "COPAY"
29 ;
30CLPRCNTG ;stub
31 Q "%%"
32 ;
33PTCLMINF ;stub
34 Q "X claims payable"
35 ;
36 ;/**
37 ;get user name from file #200
38 ;input: BPDUZ ien in file 200
39 ;output name as string
40GETUSRNM(BPDUZ) ;
41 Q $E($$GET1^DIQ(200,+BPDUZ,.01,"E"),1,20)
42 ;
43 ;/**
44 ;Checks if the CLAIM for specific Transaction is CLOSED?
45 ;BP59 - 9002313.59
46CLOSED(BP59) ;*/
47 N BPCLAIM
48 ;get claim ptr to #9002313.02
49 S BPCLAIM=+$P($G(^BPST(BP59,0)),U,3) ;$$GET1^DIQ(9002313.59,BP59,3,"I") I 'CLAIM Q 0
50 ; get closed status
51 Q +$P($G(^BPSC(BPCLAIM,900)),U)=1 ;Q $$GET1^DIQ(9002313.02,CLAIM,901,"I")
52 ;
Note: See TracBrowser for help on using the repository browser.