source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAB71.m@ 1650

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

initial load of WorldVistAEHR
File size: 5.3 KB
Line 
1DVBAB71 ;ALB/KLB - CAPRI REQUEST STATUS INQUIRY ;09/11/00
2 ;;2.7;AMIE;**35**;Apr 10, 1995
3 ;
4STRT(MSG,DFN,RECIEN) ;
5 S U="^"
6 K ^TMP("CAPRI")
7 I '$D(DFN) S MSG(1)="You must select a patient."
8 Q:'$D(DFN)
9 Q:DFN=""
10 S PTNAME=$E($P(^DPT(DFN,0),U),1,25)
11 ;S RECIEN=0,RECIEN=$O(^DVB(396,"B",DFN,RECIEN))
12 S DVB0=$G(^DVB(396,RECIEN,0)),DVB1=$G(^DVB(396,RECIEN,1)),DVB2=$G(^DVB(396,RECIEN,2)),DVB6=$G(^DVB(396,RECIEN,6))
13 S MCNT=1
14 ;S ^TMP("CAPRI",MCNT)="Patient Name: "_PTNAME_"^",MCNT=MCNT+1
15 I $P(DVB2,U,10)="L" S DOCTYP="ACTIVITY DATE: "
16 I $P(DVB2,U,10)="A" S DOCTYP="Admission Date: "
17 S Y=$P(DVB0,U,4) X ^DD("DD")
18 S ^TMP("CAPRI",MCNT)=" Patient Name: "_PTNAME_" "_DOCTYP_Y_"^",MCNT=MCNT+1
19 ;S ^TMP("CAPRI",MCNT)="SSN: "_$P(^DPT(DFN,0),U,9)_"^",MCNT=MCNT+1
20 S ^TMP("CAPRI",MCNT)=" SSN: "_$P(^DPT(DFN,0),U,9)_" Claim Number: "_$P(^DPT(DFN,.31),U,3)_"^",MCNT=MCNT+1
21 S DIV=$P(DVB2,U,9) I DIV'="" S DIV=$P(^DG(40.8,DIV,0),U)
22 S ^TMP("CAPRI",MCNT)="Receiving Div: "_DIV_"^",MCNT=MCNT+1
23 S ^TMP("CAPRI",MCNT)=" Requisition Status Status Date Operator Current Division"_"^",MCNT=MCNT+1
24 S Y=$P(DVB0,U,10) X ^DD("DD") S DIV=$P(DVB6,U,9),STAT=$P(DVB0,U,9) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
25 I DIV'="" S DIV=$P(^DG(40.8,DIV,0),U)
26 S ^TMP("CAPRI",MCNT)="---------------------------------------------------------------------------"_"^",MCNT=MCNT+1
27 S OP=$P(DVB1,U,13) I OP="" S OP=" "
28DATA S ^TMP("CAPRI",MCNT)=" Notice/Discharge: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
29 S Y=$P(DVB0,U,12) X ^DD("DD") S DIV=$P(DVB6,U,11)
30 S STAT=$P(DVB0,U,11) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
31 S OP=$P(DVB1,U,14) I OP="" S OP=" "
32 S ^TMP("CAPRI",MCNT)=" Hospital Summary: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
33 S Y=$P(DVB0,U,14) X ^DD("DD") S DIV=$P(DVB6,U,13)
34 S STAT=$P(DVB0,U,13) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
35 S OP=$P(DVB1,U,15) I OP="" S OP=" "
36 S ^TMP("CAPRI",MCNT)="21-day Certificate: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
37 S Y=$P(DVB1,U) X ^DD("DD") S DIV=$P(DVB6,U,15)
38 S STAT=$P(DVB0,U,15) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STATUS=" "
39 S OP=$P(DVB1,U,16) I OP="" S OP=" "
40 S ^TMP("CAPRI",MCNT)=" Other/Exam: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
41 S Y=$P(DVB1,U,3) X ^DD("DD") S DIV=$P(DVB6,U,17)
42 S STAT=$P(DVB0,U,17) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
43 S OP=$P(DVB1,U,17) I OP="" S OP=" "
44 S ^TMP("CAPRI",MCNT)=" Special Report: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
45 S Y=$P(DVB1,U,4) X ^DD("DD") S DIV=$P(DVB6,U,19)
46 S STAT=$P(DVB0,U,19) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
47 S OP=$P(DVB1,U,18) I OP="" S OP=" "
48 S ^TMP("CAPRI",MCNT)="Competency Report: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
49 S Y=$P(DVB1,U,5) X ^DD("DD") S DIV=$P(DVB6,U,21)
50 S STAT=$P(DVB0,U,21) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
51 S OP=$P(DVB2,U) I OP="" S OP=" "
52 S ^TMP("CAPRI",MCNT)=" Form 21-2680: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
53 S Y=$P(DVB1,U,6) X ^DD("DD") S DIV=$P(DVB6,U,23)
54 S STAT=$P(DVB0,U,23) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
55 S OP=$P(DVB2,U,2) I OP="" S OP=" "
56 S ^TMP("CAPRI",MCNT)="Asset Information: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
57 S Y=$P(DVB1,U,8) X ^DD("DD") S DIV=$P(DVB6,U,7)
58 S STAT=$P(DVB1,U,7) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
59 S OP=$P(DVB2,U,3) I OP="" S OP=" "
60 S ^TMP("CAPRI",MCNT)=" Admission Report: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
61 S Y=$P(DVB1,U,9) X ^DD("DD") S DIV=$P(DVB6,U,26)
62 S STAT=$P(DVB0,U,26) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
63 S OP=$P(DVB2,U,4) I OP="" S OP=" "
64 S ^TMP("CAPRI",MCNT)="OPT Treatment Rpt: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
65 S Y=$P(DVB1,U,10) X ^DD("DD") S DIV=$P(DVB6,U,28)
66 S STAT=$P(DVB0,U,28) I STAT="P" S STAT="PENDING " I STAT="C" S STAT="COMPLETED " I STAT="" S STAT=" "
67 S OP=$P(DVB2,U,5) I OP="" S OP=" "
68 S ^TMP("CAPRI",MCNT)=" Beg Date/Care: "_STAT_Y_" "_OP_DIV_"^",MCNT=MCNT+1
69 S ^TMP("CAPRI",MCNT)=""_"^",MCNT=MCNT+1
70 D REM
71 S ^TMP("CAPRI",MCNT)=""_"^"
72 S Y=$P(DVB1,U,12) X ^DD("DD")
73 S ^TMP("CAPRI",MCNT)="Requesting location: "_$E($P(DVB2,U,7),1,20)_" Date of Request: "_Y,MCNT=MCNT+1
74 S ^TMP("CAPRI",MCNT)=" Requested by: "_$E($P(DVB2,U,8),1,25)_" "_Y
75 S MSG=$NA(^TMP("CAPRI"))
76 ;F S XX=$O(^TMP("CAPRI",XX)) Q:'XX S MSG(XX)=$G(^TMP("CAPRI",XX))
77 K Y,PTNAME,DFN,DVB0,DVB1,DVB2,DVB6
78 Q
79REM S X=0,FLG=0
80 F S X=$O(^DVB(396,RECIEN,5,X)) Q:'X D
81 .I FLG=0 D
82 ..S ^TMP("CAPRI",MCNT)="REMARKS: "_$G(^DVB(396,RECIEN,5,X,0))_"^",MCNT=MCNT+1
83 ..S FLG=1
84 .I FLG=1&(X>1) D
85 ..S ^TMP("CAPRI",MCNT)=$G(^DVB(396,RECIEN,5,X,0))_"^",MCNT=MCNT+1
86 S ^TMP("CAPRI",MCNT)=""_"^"
87 Q
Note: See TracBrowser for help on using the repository browser.