- PXBAPI21 ;ISL/DCM - API for Classification check out ;7/25/96 15:04
- ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
- CLASS(ENCOWNTR,DFN,APTDT,LOC,VISIT) ;Edit classification fields
- ; Input - ENCOWNTR - ien of ^SCE(ien (409.68 Outpatient Encounter file)
- ; ENCOWNTR optional if DFN,LOC,APTDT params used
- ; DFN - ien of ^DPT(DFN, (only used if no ENCOWNTR)
- ; LOC - ien of ^SC(LOC, (only used if no ENCOWNTR)
- ; APTDT - Appointment Date/time (only used if no ENCOWNTR)
- ; VISIT - optional if no ENCOWNTR look for main encounter that
- ; points to this visit
- ; Output - PXBDATA(Classification type)=OutPT Class ien^Value
- ; PXBDATA("ERR",Class type)=1 Bad ptr to 409.41
- ; =2 DATA entry not applicable
- ; =3 DATA entry uneditable
- ; =4 User ^ out of prompt
- ; Classification type 1 - Agent Orange
- ; 2 - Ionizing Radiation
- ; 3 - Service Connected
- ; 4 - Environmental Contaminants
- ; Ext References: ^SCE(DA,0) INP^SDAM2
- ; REQ^SDM1A CLINIC^SDAMU
- ; EXOE^SDCOU2 CLOE^SDCO21
- ; SEQ^SDCO21 CL^SDCO21
- ; In ^PXBAPI22
- ; ^DG(43,1,"SCLR") piece 24
- ; ^SD(409.41,DA,0) ^SD(409.41,DA,2)
- ; VAL^SDCODD SC^SDCO23
- I $G(ENCOWNTR)'>0,$G(VISIT)>0 D
- . S ENCOWNTR=$O(^SCE("AVSIT",VISIT,0))
- . I ENCOWNTR,$P(^SCE(ENCOWNTR,0),"^",6) S ENCOWNTR=$P(^SCE(ENCOWNTR,0),"^",6)
- N IEN,IFN,SDCLOEY,ORG,END,DA,X,SQUIT
- 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
- Q:'$G(DFN)!'$G(LOC)!'$G(APTDT)
- S X=$G(^DPT(DFN,"S",APTDT,0))
- 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
- ON D ASKCL($G(ENCOWNTR),.SDCLOEY,DFN,APTDT)
- I '$D(SDCLOEY) Q
- I $D(SDCLOEY) D ASK($G(ENCOWNTR),.SDCLOEY,.SQUIT) Q:$D(SQUIT)
- Q
- ASKCL(ENCOWNTR,SDCLOEY,DFN,APTDT) ;Ask classifications on check out
- I $G(ENCOWNTR) D CLOE^SDCO21(ENCOWNTR,.SDCLOEY) Q
- D CL^SDCO21(DFN,APTDT,"",.SDCLOEY)
- Q
- ASK(ENCOWNTR,SDCLOEY,SQUIT) ;Ask classifications
- N I,IOINHI,IOINORM,TYPI,TYPSEQ,CTS,X
- S X="IOINHI;IOINORM" D ENDR^%ZISS
- I '$D(SDCLOEY) Q
- W !!,"--- ",IOINHI,"Classification",IOINORM," --- [",IOINHI,"Required",IOINORM,"]"
- W ! S TYPSEQ=$$SEQ^SDCO21 ;Get classification type sequence (3,1,2,4)
- F CTS=1:1 S TYPI=+$P(TYPSEQ,",",CTS) Q:'TYPI!($D(SQUIT)) D
- .I $D(SDCLOEY(TYPI)) D
- ..D ONE^PXBAPI22(TYPI,SDCLOEY(TYPI),ENCOWNTR,.SQUIT)
- ..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)=""
- Q
- ENCHK(ENCOWNTR,X0) ;Do outpatient encounter checks
- S APTDT=+X0,DFN=$P(X0,"^",2),LOC=$P(X0,"^",4),ORG=$P(X0,"^",8),DA=$P(X0,"^",9)
- I $$REQ^SDM1A(+X0)'="CO" S END=1 Q ;Check MAS Check out date parameter
- I ORG=1,'$$CLINIC^SDAMU(+LOC) S END=1 Q ;Screen for valid clinic
- I "^1^2^"[("^"_ORG_"^"),$$INP^SDAM2(+DFN,+X0)="I" S END=1 Q ;Inpat chk
- I $$EXOE^SDCOU2(ENCOWNTR) S END=1 Q ;Chk exempt Outpt classifications
- Q
- TEST ;Test call to CLASS
- N PXIFN S PXIFN=63
- 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
- . D CLASS(PXIFN)
- . ;W ! ZW PXBDATA
- Q
- PXBAPI21 ;ISL/DCM - API for Classification check out ;7/25/96 15:04
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
- CLASS(ENCOWNTR,DFN,APTDT,LOC,VISIT) ;Edit classification fields
- +1 ; Input - ENCOWNTR - ien of ^SCE(ien (409.68 Outpatient Encounter file)
- +2 ; ENCOWNTR optional if DFN,LOC,APTDT params used
- +3 ; DFN - ien of ^DPT(DFN, (only used if no ENCOWNTR)
- +4 ; LOC - ien of ^SC(LOC, (only used if no ENCOWNTR)
- +5 ; APTDT - Appointment Date/time (only used if no ENCOWNTR)
- +6 ; VISIT - optional if no ENCOWNTR look for main encounter that
- +7 ; points to this visit
- +8 ; Output - PXBDATA(Classification type)=OutPT Class ien^Value
- +9 ; PXBDATA("ERR",Class type)=1 Bad ptr to 409.41
- +10 ; =2 DATA entry not applicable
- +11 ; =3 DATA entry uneditable
- +12 ; =4 User ^ out of prompt
- +13 ; Classification type 1 - Agent Orange
- +14 ; 2 - Ionizing Radiation
- +15 ; 3 - Service Connected
- +16 ; 4 - Environmental Contaminants
- +17 ; Ext References: ^SCE(DA,0) INP^SDAM2
- +18 ; REQ^SDM1A CLINIC^SDAMU
- +19 ; EXOE^SDCOU2 CLOE^SDCO21
- +20 ; SEQ^SDCO21 CL^SDCO21
- +21 ; In ^PXBAPI22
- +22 ; ^DG(43,1,"SCLR") piece 24
- +23 ; ^SD(409.41,DA,0) ^SD(409.41,DA,2)
- +24 ; VAL^SDCODD SC^SDCO23
- +25 IF $GET(ENCOWNTR)'>0
- IF $GET(VISIT)>0
- Begin DoDot:1
- +26 SET ENCOWNTR=$ORDER(^SCE("AVSIT",VISIT,0))
- +27 IF ENCOWNTR
- IF $PIECE(^SCE(ENCOWNTR,0),"^",6)
- SET ENCOWNTR=$PIECE(^SCE(ENCOWNTR,0),"^",6)
- End DoDot:1
- +28 NEW IEN,IFN,SDCLOEY,ORG,END,DA,X,SQUIT
- +29 IF $GET(ENCOWNTR)
- IF '$DATA(^SCE(+ENCOWNTR,0))
- QUIT
- NEW APTDT,DFN,LOC
- SET END=0
- SET X0=^(0)
- DO ENCHK(ENCOWNTR,X0)
- IF END
- QUIT
- GOTO ON
- +30 IF '$GET(DFN)!'$GET(LOC)!'$GET(APTDT)
- QUIT
- +31 SET X=$GET(^DPT(DFN,"S",APTDT,0))
- +32 IF +X
- IF +X=LOC
- IF $PIECE(X,"^",20)
- IF $DATA(^SCE($PIECE(X,"^",20),0))
- SET ENCOWNTR=$PIECE(X,"^",20)
- SET END=0
- SET X0=^(0)
- DO ENCHK(ENCOWNTR,X0)
- IF END
- QUIT
- GOTO ON
- ON DO ASKCL($GET(ENCOWNTR),.SDCLOEY,DFN,APTDT)
- +1 IF '$DATA(SDCLOEY)
- QUIT
- +2 IF $DATA(SDCLOEY)
- DO ASK($GET(ENCOWNTR),.SDCLOEY,.SQUIT)
- IF $DATA(SQUIT)
- QUIT
- +3 QUIT
- ASKCL(ENCOWNTR,SDCLOEY,DFN,APTDT) ;Ask classifications on check out
- +1 IF $GET(ENCOWNTR)
- DO CLOE^SDCO21(ENCOWNTR,.SDCLOEY)
- QUIT
- +2 DO CL^SDCO21(DFN,APTDT,"",.SDCLOEY)
- +3 QUIT
- ASK(ENCOWNTR,SDCLOEY,SQUIT) ;Ask classifications
- +1 NEW I,IOINHI,IOINORM,TYPI,TYPSEQ,CTS,X
- +2 SET X="IOINHI;IOINORM"
- DO ENDR^%ZISS
- +3 IF '$DATA(SDCLOEY)
- QUIT
- +4 WRITE !!,"--- ",IOINHI,"Classification",IOINORM," --- [",IOINHI,"Required",IOINORM,"]"
- +5 ;Get classification type sequence (3,1,2,4)
- WRITE !
- SET TYPSEQ=$$SEQ^SDCO21
- +6 FOR CTS=1:1
- SET TYPI=+$PIECE(TYPSEQ,",",CTS)
- IF 'TYPI!($DATA(SQUIT))
- QUIT
- Begin DoDot:1
- +7 IF $DATA(SDCLOEY(TYPI))
- Begin DoDot:2
- +8 DO ONE^PXBAPI22(TYPI,SDCLOEY(TYPI),ENCOWNTR,.SQUIT)
- +9 IF TYPI=3
- FOR I=1,2,4
- IF $DATA(SDCLOEY(I))&($PIECE($GET(PXBDATA(3)),"^",2)=1)
- SET $PIECE(SDCLOEY(I),"^",3)=1
- IF $PIECE($GET(PXBDATA(3)),"^",2)=0&('$DATA(SDCLOEY(I)))
- SET SDCLOEY(I)=""
- End DoDot:2
- End DoDot:1
- +10 QUIT
- ENCHK(ENCOWNTR,X0) ;Do outpatient encounter checks
- +1 SET APTDT=+X0
- SET DFN=$PIECE(X0,"^",2)
- SET LOC=$PIECE(X0,"^",4)
- SET ORG=$PIECE(X0,"^",8)
- SET DA=$PIECE(X0,"^",9)
- +2 ;Check MAS Check out date parameter
- IF $$REQ^SDM1A(+X0)'="CO"
- SET END=1
- QUIT
- +3 ;Screen for valid clinic
- IF ORG=1
- IF '$$CLINIC^SDAMU(+LOC)
- SET END=1
- QUIT
- +4 ;Inpat chk
- IF "^1^2^"[("^"_ORG_"^")
- IF $$INP^SDAM2(+DFN,+X0)="I"
- SET END=1
- QUIT
- +5 ;Chk exempt Outpt classifications
- IF $$EXOE^SDCOU2(ENCOWNTR)
- SET END=1
- QUIT
- +6 QUIT
- TEST ;Test call to CLASS
- +1 NEW PXIFN
- SET PXIFN=63
- +2 FOR
- SET PXIFN=$ORDER(^SCE(PXIFN))
- IF PXIFN<1
- QUIT
- SET DFN=$PIECE(^(PXIFN,0),"^",2)
- KILL PXBDATA
- WRITE !!,PXIFN_" "_$PIECE(^DPT(DFN,0),"^")
- Begin DoDot:1
- +3 DO CLASS(PXIFN)
- +4 ;W ! ZW PXBDATA
- End DoDot:1
- SET %=1
- WRITE !,"Continue "
- DO YN^DICN
- IF %'=1
- QUIT
- +5 QUIT
