PXBAPI21 ;ISL/DCM - API for Classification check out ; 3/16/23 12:55pm
;;1.0;PCE PATIENT CARE ENCOUNTER;**130,147,124,184,168,235**;Aug 12, 1996;Build 25
; Reference to ^SCE(DA,0) in ICR #2065
; Reference to INP^SDAM2 in ICR #1582
; Reference to REQ^SDM1A in ICR #1583
; Reference to CLINIC^SDAMU in ICR #1580
; Reference to EXOE^SDCOU2 in ICR #1015
; Reference to CLOE^SDCO21 in ICR #1300
; Reference to SEQ^SDCO21 in ICR #1300
; Reference to CL^SDCO21 in ICR #1300
; Reference to ^SCE("AVSIT") in ICR #2045
;
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 - SW Asia Coditions
; 5 - Military Sexual Trauma
; 6 - Head and/or Neck Cancer
; 7 - Combat Veteran
; 8 - Project 112/SHAD
;
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)
. I DFN="",VISIT'="" S DFN=$P(^AUPNVSIT(VISIT,0),U,5)
N IEN,IFN,SDCLOEY,ORG,END,DA,X,SQUIT
I $G(ENCOWNTR) Q:'$D(^SCE(+ENCOWNTR,0)) D ;PX*1.0*235 changed above to dot structure
. N APTDT,DFN,LOC ;PX*1.0*235
. S END=0,X0=^SCE(+ENCOWNTR,0) ;PX*1.0*235 remove naked reference
. D ENCHK(ENCOWNTR,X0) Q:END ;PX*1.0*235
. I DFN="",ENCOWNTR'="" S DFN=$P(X0,U,2) ;PX*1.0*235
. G:$D(ENCOWNTR)=0 ON ;PX*1.0*235
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
S END=0 D OPCHK(DFN,LOC,APTDT) I END Q
ON D ASKCL($G(ENCOWNTR),.SDCLOEY,DFN,APTDT)
D SC^PXCEVFI2(DFN) ;PX*1.0*235 moved to ON tag
I '$D(SDCLOEY) Q
I $G(PXCECAT)="POV" D
.I $P($G(PXCEAFTR(800)),"^",1)]"",$D(SDCLOEY(3)) S $P(SDCLOEY(3),"^",2)=$P(PXCEAFTR(800),"^",1)
.I $P($G(PXCEAFTR(800)),"^",2)]"",$D(SDCLOEY(1)) S $P(SDCLOEY(1),"^",2)=$P(PXCEAFTR(800),"^",2)
.I $P($G(PXCEAFTR(800)),"^",3)]"",$D(SDCLOEY(2)) S $P(SDCLOEY(2),"^",2)=$P(PXCEAFTR(800),"^",3)
.I $P($G(PXCEAFTR(800)),"^",4)]"",$D(SDCLOEY(4)) S $P(SDCLOEY(4),"^",2)=$P(PXCEAFTR(800),"^",4)
.I $P($G(PXCEAFTR(800)),"^",5)]"",$D(SDCLOEY(5)) S $P(SDCLOEY(5),"^",2)=$P(PXCEAFTR(800),"^",5)
.I $P($G(PXCEAFTR(800)),"^",6)]"",$D(SDCLOEY(6)) S $P(SDCLOEY(6),"^",2)=$P(PXCEAFTR(800),"^",6)
.I $P($G(PXCEAFTR(800)),"^",7)]"",$D(SDCLOEY(7)) S $P(SDCLOEY(7),"^",2)=$P(PXCEAFTR(800),"^",7)
.I $P($G(PXCEAFTR(800)),"^",8)]"",$D(SDCLOEY(8)) S $P(SDCLOEY(8),"^",2)=$P(PXCEAFTR(800),"^",8)
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,PXVST,PXEOCNUM,PXANS
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,5,6,7)
F CTS=1:1 S TYPI=+$P(TYPSEQ,",",CTS) Q:'TYPI!($D(SQUIT)) D
.I $D(SDCLOEY(TYPI)) D
..S PXVST=$P($G(X0),U,5) I 'PXVST,($G(PXCECAT)="VST")!($G(PXCECAT)="SIT") Q
..I $G(PXCECAT)="VST",TYPI=3,($P($G(^AUPNVSIT(PXVST,800)),U,11)="1") Q
..I $G(PXCECAT)="VST",TYPI=1,($P($G(^AUPNVSIT(PXVST,800)),U,12)="1") Q
..I $G(PXCECAT)="VST",TYPI=2,($P($G(^AUPNVSIT(PXVST,800)),U,13)="1") Q
..I $G(PXCECAT)="VST",TYPI=4,($P($G(^AUPNVSIT(PXVST,800)),U,14)="1") Q
..I $G(PXCECAT)="VST",TYPI=5,($P($G(^AUPNVSIT(PXVST,800)),U,15)="1") Q
..I $G(PXCECAT)="VST",TYPI=6,($P($G(^AUPNVSIT(PXVST,800)),U,16)="1") Q
..I $G(PXCECAT)="VST",TYPI=7,($P($G(^AUPNVSIT(PXVST,800)),U,17)="1") Q
..I $G(PXCECAT)="VST",TYPI=8,($P($G(^AUPNVSIT(PXVST,800)),U,18)="1") Q
..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)=""
I $P($G(PXBDATA(3)),"^",2)'="" D
.N END,PXPOS
.S END=0,PXPOS=""
.F CTS=1:1 S TYPI=+$P(TYPSEQ,",",CTS) Q:'TYPI I TYPI'=3 D
..I $P($G(PXBDATA(TYPI)),"^",2)'="" S END=1 Q
.I 'END H 1
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 +$G(VADM(6)),+$G(VADM(6))<APTDT D K DIR I $D(DIRUT) S (PXDOD,END)=1 Q
. S DIR(0)="E",DIR("A")="Enter RETURN to continue or '^' to Quit"
. S DIR("A",2)="WARNING "_VADM(7),DIR("A",1)=" ",DIR("A",3)=" " D ^DIR
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
OPCHK(DFN,LOC,APTDT) ;Do standalone outpatient encounter checks
I +$G(VADM(6)),+$G(VADM(6))<APTDT D K DIR I $D(DIRUT) S (PXDOD,END)=1 Q
. S DIR(0)="E",DIR("A")="Enter RETURN to continue or '^' to Quit"
. S DIR("A",2)="WARNING "_VADM(7),DIR("A",1)=" ",DIR("A",3)=" " D ^DIR
I $$REQ^SDM1A(APTDT)'="CO" S END=1 Q ;Check MAS Check out date parameter
I '$$CLINIC^SDAMU(+LOC) S END=1 Q ;Screen for valid clinic
I $$INP^SDAM2(+DFN,APTDT)="I" S END=1 Q ;Inpat chk
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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBAPI21 6620 printed Apr 09, 2024@21:33:27 Page 2
PXBAPI21 ;ISL/DCM - API for Classification check out ; 3/16/23 12:55pm
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**130,147,124,184,168,235**;Aug 12, 1996;Build 25
+2 ; Reference to ^SCE(DA,0) in ICR #2065
+3 ; Reference to INP^SDAM2 in ICR #1582
+4 ; Reference to REQ^SDM1A in ICR #1583
+5 ; Reference to CLINIC^SDAMU in ICR #1580
+6 ; Reference to EXOE^SDCOU2 in ICR #1015
+7 ; Reference to CLOE^SDCO21 in ICR #1300
+8 ; Reference to SEQ^SDCO21 in ICR #1300
+9 ; Reference to CL^SDCO21 in ICR #1300
+10 ; Reference to ^SCE("AVSIT") in ICR #2045
+11 ;
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 - SW Asia Coditions
+17 ; 5 - Military Sexual Trauma
+18 ; 6 - Head and/or Neck Cancer
+19 ; 7 - Combat Veteran
+20 ; 8 - Project 112/SHAD
+21 ;
+22 IF $GET(ENCOWNTR)'>0
IF $GET(VISIT)>0
Begin DoDot:1
+23 SET ENCOWNTR=$ORDER(^SCE("AVSIT",VISIT,0))
+24 IF ENCOWNTR
IF $PIECE(^SCE(ENCOWNTR,0),"^",6)
SET ENCOWNTR=$PIECE(^SCE(ENCOWNTR,0),"^",6)
+25 IF DFN=""
IF VISIT'=""
SET DFN=$PIECE(^AUPNVSIT(VISIT,0),U,5)
End DoDot:1
+26 NEW IEN,IFN,SDCLOEY,ORG,END,DA,X,SQUIT
+27 ;PX*1.0*235 changed above to dot structure
IF $GET(ENCOWNTR)
if '$DATA(^SCE(+ENCOWNTR,0))
QUIT
Begin DoDot:1
+28 ;PX*1.0*235
NEW APTDT,DFN,LOC
+29 ;PX*1.0*235 remove naked reference
SET END=0
SET X0=^SCE(+ENCOWNTR,0)
+30 ;PX*1.0*235
DO ENCHK(ENCOWNTR,X0)
if END
QUIT
+31 ;PX*1.0*235
IF DFN=""
IF ENCOWNTR'=""
SET DFN=$PIECE(X0,U,2)
+32 ;PX*1.0*235
if $DATA(ENCOWNTR)=0
GOTO ON
End DoDot:1
+33 if '$GET(DFN)!'$GET(LOC)!'$GET(APTDT)
QUIT
+34 SET X=$GET(^DPT(DFN,"S",APTDT,0))
+35 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
+36 SET END=0
DO OPCHK(DFN,LOC,APTDT)
IF END
QUIT
ON DO ASKCL($GET(ENCOWNTR),.SDCLOEY,DFN,APTDT)
+1 ;PX*1.0*235 moved to ON tag
DO SC^PXCEVFI2(DFN)
+2 IF '$DATA(SDCLOEY)
QUIT
+3 IF $GET(PXCECAT)="POV"
Begin DoDot:1
+4 IF $PIECE($GET(PXCEAFTR(800)),"^",1)]""
IF $DATA(SDCLOEY(3))
SET $PIECE(SDCLOEY(3),"^",2)=$PIECE(PXCEAFTR(800),"^",1)
+5 IF $PIECE($GET(PXCEAFTR(800)),"^",2)]""
IF $DATA(SDCLOEY(1))
SET $PIECE(SDCLOEY(1),"^",2)=$PIECE(PXCEAFTR(800),"^",2)
+6 IF $PIECE($GET(PXCEAFTR(800)),"^",3)]""
IF $DATA(SDCLOEY(2))
SET $PIECE(SDCLOEY(2),"^",2)=$PIECE(PXCEAFTR(800),"^",3)
+7 IF $PIECE($GET(PXCEAFTR(800)),"^",4)]""
IF $DATA(SDCLOEY(4))
SET $PIECE(SDCLOEY(4),"^",2)=$PIECE(PXCEAFTR(800),"^",4)
+8 IF $PIECE($GET(PXCEAFTR(800)),"^",5)]""
IF $DATA(SDCLOEY(5))
SET $PIECE(SDCLOEY(5),"^",2)=$PIECE(PXCEAFTR(800),"^",5)
+9 IF $PIECE($GET(PXCEAFTR(800)),"^",6)]""
IF $DATA(SDCLOEY(6))
SET $PIECE(SDCLOEY(6),"^",2)=$PIECE(PXCEAFTR(800),"^",6)
+10 IF $PIECE($GET(PXCEAFTR(800)),"^",7)]""
IF $DATA(SDCLOEY(7))
SET $PIECE(SDCLOEY(7),"^",2)=$PIECE(PXCEAFTR(800),"^",7)
+11 IF $PIECE($GET(PXCEAFTR(800)),"^",8)]""
IF $DATA(SDCLOEY(8))
SET $PIECE(SDCLOEY(8),"^",2)=$PIECE(PXCEAFTR(800),"^",8)
End DoDot:1
+12 IF $DATA(SDCLOEY)
DO ASK($GET(ENCOWNTR),.SDCLOEY,.SQUIT)
if $DATA(SQUIT)
QUIT
+13 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,PXVST,PXEOCNUM,PXANS
+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,5,6,7)
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 SET PXVST=$PIECE($GET(X0),U,5)
IF 'PXVST
IF ($GET(PXCECAT)="VST")!($GET(PXCECAT)="SIT")
QUIT
+9 IF $GET(PXCECAT)="VST"
IF TYPI=3
IF ($PIECE($GET(^AUPNVSIT(PXVST,800)),U,11)="1")
QUIT
+10 IF $GET(PXCECAT)="VST"
IF TYPI=1
IF ($PIECE($GET(^AUPNVSIT(PXVST,800)),U,12)="1")
QUIT
+11 IF $GET(PXCECAT)="VST"
IF TYPI=2
IF ($PIECE($GET(^AUPNVSIT(PXVST,800)),U,13)="1")
QUIT
+12 IF $GET(PXCECAT)="VST"
IF TYPI=4
IF ($PIECE($GET(^AUPNVSIT(PXVST,800)),U,14)="1")
QUIT
+13 IF $GET(PXCECAT)="VST"
IF TYPI=5
IF ($PIECE($GET(^AUPNVSIT(PXVST,800)),U,15)="1")
QUIT
+14 IF $GET(PXCECAT)="VST"
IF TYPI=6
IF ($PIECE($GET(^AUPNVSIT(PXVST,800)),U,16)="1")
QUIT
+15 IF $GET(PXCECAT)="VST"
IF TYPI=7
IF ($PIECE($GET(^AUPNVSIT(PXVST,800)),U,17)="1")
QUIT
+16 IF $GET(PXCECAT)="VST"
IF TYPI=8
IF ($PIECE($GET(^AUPNVSIT(PXVST,800)),U,18)="1")
QUIT
+17 DO ONE^PXBAPI22(TYPI,SDCLOEY(TYPI),ENCOWNTR,.SQUIT)
+18 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
+19 IF $PIECE($GET(PXBDATA(3)),"^",2)'=""
Begin DoDot:1
+20 NEW END,PXPOS
+21 SET END=0
SET PXPOS=""
+22 FOR CTS=1:1
SET TYPI=+$PIECE(TYPSEQ,",",CTS)
if 'TYPI
QUIT
IF TYPI'=3
Begin DoDot:2
+23 IF $PIECE($GET(PXBDATA(TYPI)),"^",2)'=""
SET END=1
QUIT
End DoDot:2
+24 IF 'END
HANG 1
End DoDot:1
+25 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 IF +$GET(VADM(6))
IF +$GET(VADM(6))<APTDT
Begin DoDot:1
+3 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to continue or '^' to Quit"
+4 SET DIR("A",2)="WARNING "_VADM(7)
SET DIR("A",1)=" "
SET DIR("A",3)=" "
DO ^DIR
End DoDot:1
KILL DIR
IF $DATA(DIRUT)
SET (PXDOD,END)=1
QUIT
+5 ;Check MAS Check out date parameter
IF $$REQ^SDM1A(+X0)'="CO"
SET END=1
QUIT
+6 ;Screen for valid clinic
IF ORG=1
IF '$$CLINIC^SDAMU(+LOC)
SET END=1
QUIT
+7 ;Inpat chk
IF "^1^2^"[("^"_ORG_"^")
IF $$INP^SDAM2(+DFN,+X0)="I"
SET END=1
QUIT
+8 ;Chk exempt Outpt classifications
IF $$EXOE^SDCOU2(ENCOWNTR)
SET END=1
QUIT
+9 QUIT
OPCHK(DFN,LOC,APTDT) ;Do standalone outpatient encounter checks
+1 IF +$GET(VADM(6))
IF +$GET(VADM(6))<APTDT
Begin DoDot:1
+2 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to continue or '^' to Quit"
+3 SET DIR("A",2)="WARNING "_VADM(7)
SET DIR("A",1)=" "
SET DIR("A",3)=" "
DO ^DIR
End DoDot:1
KILL DIR
IF $DATA(DIRUT)
SET (PXDOD,END)=1
QUIT
+4 ;Check MAS Check out date parameter
IF $$REQ^SDM1A(APTDT)'="CO"
SET END=1
QUIT
+5 ;Screen for valid clinic
IF '$$CLINIC^SDAMU(+LOC)
SET END=1
QUIT
+6 ;Inpat chk
IF $$INP^SDAM2(+DFN,APTDT)="I"
SET END=1
QUIT
+7 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)
End DoDot:1
SET %=1
WRITE !,"Continue "
DO YN^DICN
if %'=1
QUIT
+4 QUIT
