source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXBAPI21.m@ 1000

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

initial load of WorldVistAEHR
File size: 5.9 KB
RevLine 
[613]1PXBAPI21 ;ISL/DCM - API for Classification check out ; 4/13/05 12:55pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**130,147,124,184**;Aug 12, 1996;Build 30
3CLASS(ENCOWNTR,DFN,APTDT,LOC,VISIT) ;Edit classification fields
4 ; Input - ENCOWNTR - ien of ^SCE(ien (409.68 Outpatient Encounter file)
5 ; ENCOWNTR optional if DFN,LOC,APTDT params used
6 ; DFN - ien of ^DPT(DFN, (only used if no ENCOWNTR)
7 ; LOC - ien of ^SC(LOC, (only used if no ENCOWNTR)
8 ; APTDT - Appointment Date/time (only used if no ENCOWNTR)
9 ; VISIT - optional if no ENCOWNTR look for main encounter that
10 ; points to this visit
11 ; Output - PXBDATA(Classification type)=OutPT Class ien^Value
12 ; PXBDATA("ERR",Class type)=1 Bad ptr to 409.41
13 ; =2 DATA entry not applicable
14 ; =3 DATA entry uneditable
15 ; =4 User ^ out of prompt
16 ; Classification type 1 - Agent Orange
17 ; 2 - Ionizing Radiation
18 ; 3 - Service Connected
19 ; 4 - Environmental Contaminants
20 ; 5 - Military Sexual Trauma
21 ; 6 - Head and/or Neck Cancer
22 ; 7 - Combat Veteran
23 ;
24 ; Ext References: ^SCE(DA,0) INP^SDAM2
25 ; REQ^SDM1A CLINIC^SDAMU
26 ; EXOE^SDCOU2 CLOE^SDCO21
27 ; SEQ^SDCO21 CL^SDCO21
28 ; In ^PXBAPI22
29 ; ^DG(43,1,"SCLR") piece 24
30 ; ^SD(409.41,DA,0) ^SD(409.41,DA,2)
31 ; VAL^SDCODD SC^SDCO23
32 I $G(ENCOWNTR)'>0,$G(VISIT)>0 D SC^PXCEVFI2($P(^AUPNVSIT(VISIT,0),U,5)) D
33 . S ENCOWNTR=$O(^SCE("AVSIT",VISIT,0))
34 . I ENCOWNTR,$P(^SCE(ENCOWNTR,0),"^",6) S ENCOWNTR=$P(^SCE(ENCOWNTR,0),"^",6)
35 N IEN,IFN,SDCLOEY,ORG,END,DA,X,SQUIT
36 I $G(ENCOWNTR) Q:'$D(^SCE(+ENCOWNTR,0)) N APTDT,DFN,LOC S END=0,X0=^(0) D ENCHK(ENCOWNTR,X0) Q:END G ON
37 Q:'$G(DFN)!'$G(LOC)!'$G(APTDT)
38 D SC^PXCEVFI2(DFN)
39 S X=$G(^DPT(DFN,"S",APTDT,0))
40 I +X,+X=LOC,$P(X,"^",20),$D(^SCE($P(X,"^",20),0)) S ENCOWNTR=$P(X,"^",20),END=0,X0=^(0) D ENCHK(ENCOWNTR,X0) Q:END G ON
41 S END=0 D OPCHK(DFN,LOC,APTDT) I END Q
42ON D ASKCL($G(ENCOWNTR),.SDCLOEY,DFN,APTDT)
43 I '$D(SDCLOEY) Q
44 I $G(PXCECAT)="POV" D
45 .I $P($G(PXCEAFTR(800)),"^",1)]"",$D(SDCLOEY(3)) S $P(SDCLOEY(3),"^",2)=$P(PXCEAFTR(800),"^",1)
46 .I $P($G(PXCEAFTR(800)),"^",2)]"",$D(SDCLOEY(1)) S $P(SDCLOEY(1),"^",2)=$P(PXCEAFTR(800),"^",2)
47 .I $P($G(PXCEAFTR(800)),"^",3)]"",$D(SDCLOEY(2)) S $P(SDCLOEY(2),"^",2)=$P(PXCEAFTR(800),"^",3)
48 .I $P($G(PXCEAFTR(800)),"^",4)]"",$D(SDCLOEY(4)) S $P(SDCLOEY(4),"^",2)=$P(PXCEAFTR(800),"^",4)
49 .I $P($G(PXCEAFTR(800)),"^",5)]"",$D(SDCLOEY(5)) S $P(SDCLOEY(5),"^",2)=$P(PXCEAFTR(800),"^",5)
50 .I $P($G(PXCEAFTR(800)),"^",6)]"",$D(SDCLOEY(6)) S $P(SDCLOEY(6),"^",2)=$P(PXCEAFTR(800),"^",6)
51 .I $P($G(PXCEAFTR(800)),"^",7)]"",$D(SDCLOEY(7)) S $P(SDCLOEY(7),"^",2)=$P(PXCEAFTR(800),"^",7)
52 I $D(SDCLOEY) D ASK($G(ENCOWNTR),.SDCLOEY,.SQUIT) Q:$D(SQUIT)
53 Q
54ASKCL(ENCOWNTR,SDCLOEY,DFN,APTDT) ;Ask classifications on check out
55 I $G(ENCOWNTR) D CLOE^SDCO21(ENCOWNTR,.SDCLOEY) Q
56 D CL^SDCO21(DFN,APTDT,"",.SDCLOEY)
57 Q
58ASK(ENCOWNTR,SDCLOEY,SQUIT) ;Ask classifications
59 N I,IOINHI,IOINORM,TYPI,TYPSEQ,CTS,X,PXVST
60 S X="IOINHI;IOINORM" D ENDR^%ZISS
61 I '$D(SDCLOEY) Q
62 W !!,"--- ",IOINHI,"Classification",IOINORM," --- [",IOINHI,"Required",IOINORM,"]"
63 W ! S TYPSEQ=$$SEQ^SDCO21 ;Get classification type sequence (3,1,2,4,5,6,7)
64 F CTS=1:1 S TYPI=+$P(TYPSEQ,",",CTS) Q:'TYPI!($D(SQUIT)) D
65 .I $D(SDCLOEY(TYPI)) D
66 ..S PXVST=$P($G(X0),U,5) I 'PXVST,($G(PXCECAT)="VST")!($G(PXCECAT)="SIT") Q
67 ..I $G(PXCECAT)="VST",TYPI=3,($P($G(^AUPNVSIT(PXVST,800)),U,11)="1") Q
68 ..I $G(PXCECAT)="VST",TYPI=1,($P($G(^AUPNVSIT(PXVST,800)),U,12)="1") Q
69 ..I $G(PXCECAT)="VST",TYPI=2,($P($G(^AUPNVSIT(PXVST,800)),U,13)="1") Q
70 ..I $G(PXCECAT)="VST",TYPI=4,($P($G(^AUPNVSIT(PXVST,800)),U,14)="1") Q
71 ..I $G(PXCECAT)="VST",TYPI=5,($P($G(^AUPNVSIT(PXVST,800)),U,15)="1") Q
72 ..I $G(PXCECAT)="VST",TYPI=6,($P($G(^AUPNVSIT(PXVST,800)),U,16)="1") Q
73 ..I $G(PXCECAT)="VST",TYPI=7,($P($G(^AUPNVSIT(PXVST,800)),U,17)="1") Q
74 ..D ONE^PXBAPI22(TYPI,SDCLOEY(TYPI),ENCOWNTR,.SQUIT)
75 ..I TYPI=3 F I=1,2,4 S:$D(SDCLOEY(I))&($P($G(PXBDATA(3)),"^",2)=1) $P(SDCLOEY(I),"^",3)=1 S:$P($G(PXBDATA(3)),"^",2)=0&('$D(SDCLOEY(I))) SDCLOEY(I)=""
76 I $P($G(PXBDATA(3)),"^",2)'="" D
77 .N END
78 .S END=0
79 .F CTS=1:1 S TYPI=+$P(TYPSEQ,",",CTS) Q:'TYPI I TYPI'=3 D
80 ..I $P($G(PXBDATA(TYPI)),"^",2)'="" S END=1 Q
81 .I 'END H 1
82 Q
83ENCHK(ENCOWNTR,X0) ;Do outpatient encounter checks
84 S APTDT=+X0,DFN=$P(X0,"^",2),LOC=$P(X0,"^",4),ORG=$P(X0,"^",8),DA=$P(X0,"^",9)
85 I +$G(VADM(6)),+$G(VADM(6))<APTDT D K DIR I $D(DIRUT) S (PXDOD,END)=1 Q
86 . S DIR(0)="E",DIR("A")="Enter RETURN to continue or '^' to Quit"
87 . S DIR("A",2)="WARNING "_VADM(7),DIR("A",1)=" ",DIR("A",3)=" " D ^DIR
88 I $$REQ^SDM1A(+X0)'="CO" S END=1 Q ;Check MAS Check out date parameter
89 I ORG=1,'$$CLINIC^SDAMU(+LOC) S END=1 Q ;Screen for valid clinic
90 I "^1^2^"[("^"_ORG_"^"),$$INP^SDAM2(+DFN,+X0)="I" S END=1 Q ;Inpat chk
91 I $$EXOE^SDCOU2(ENCOWNTR) S END=1 Q ;Chk exempt Outpt classifications
92 Q
93OPCHK(DFN,LOC,APTDT) ;Do standalone outpatient encounter checks
94 I +$G(VADM(6)),+$G(VADM(6))<APTDT D K DIR I $D(DIRUT) S (PXDOD,END)=1 Q
95 . S DIR(0)="E",DIR("A")="Enter RETURN to continue or '^' to Quit"
96 . S DIR("A",2)="WARNING "_VADM(7),DIR("A",1)=" ",DIR("A",3)=" " D ^DIR
97 I $$REQ^SDM1A(APTDT)'="CO" S END=1 Q ;Check MAS Check out date parameter
98 I '$$CLINIC^SDAMU(+LOC) S END=1 Q ;Screen for valid clinic
99 I $$INP^SDAM2(+DFN,APTDT)="I" S END=1 Q ;Inpat chk
100 Q
101TEST ;Test call to CLASS
102 N PXIFN S PXIFN=63
103 F S PXIFN=$O(^SCE(PXIFN)) Q:PXIFN<1 S DFN=$P(^(PXIFN,0),"^",2) K PXBDATA W !!,PXIFN_" "_$P(^DPT(DFN,0),"^") D S %=1 W !,"Continue " D YN^DICN Q:%'=1
104 . D CLASS(PXIFN)
105 . ;W ! ZW PXBDATA
106 Q
Note: See TracBrowser for help on using the repository browser.