PXBAPI21 ;ISL/DCM - API for Classification check out ;Aug 04, 2025@11:51:40
;;1.0;PCE PATIENT CARE ENCOUNTER;**130,147,124,184,168,235,240,244**;Aug 12, 1996;Build 37
; Reference to ^SCE(DA,0) in ICR #402
; 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
;
; In ^PXBAPI22 which is called by PXBAPI21 (not documented in ^PXBAPI22)
; Reference to ^DG(43,1,"SCLR") piece 24 in ICR #2085
; Reference to ^SD(409.41,DA,0), ^SD(409.41,DA,2) in ICR #2083
; Reference to VAL^SDCODD in ICR #2025
; Reference to SC^SDCO23 in ICR #2468
; Reference to ^DPT(D0,"S", in ICR #1301
;
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 CODE,CODES,IEN,IFN,NODE,PXDIAG,SAS,SDCLOEY,SEQ,ORG,END,DA,X,SIDX,SQUIT
I $G(ENCOWNTR) Q:'$D(^SCE(+ENCOWNTR,0)) N APTDT,DFN,LOC S END=0,X0=^SCE(+ENCOWNTR,0) D ENCHK(ENCOWNTR,X0) Q:END G ON ;PX*1.0*240 removed dot structure to ensure proper command flow
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
I +$G(VISIT)=0 S VISIT=$P($G(^SCE(+ENCOWNTR,0)),U,5)
ON ;D ASKCL($G(ENCOWNTR),.SDCLOEY,DFN,APTDT)
D SC^PXCEVFI2(DFN) ;PX*1.0*235 moved to ON tag
D GETPATSA^PXSPECAUTH(DFN,APTDT,LOC,VISIT,.SAS)
S CODE="" F S CODE=$O(SAS(CODE)) Q:CODE="" D
.I +$P(SAS(CODE),U)=0 Q
.S SIDX=+$O(^PXIND(820,"C",CODE,"")) I SIDX=0 Q
.S NODE=$G(^PXIND(820,SIDX,0)) S SEQ=$P(NODE,U,4)
.I CODE="SC",$P(SAS(CODE),U,2)="" I +$$SC^SDSCAPI(DFN,.PXDIAG,ENCOWNTR,$G(VISIT))>0 S $P(SAS(CODE),U,2)=1
.S CODES(SEQ)=SIDX_U_$TR($P(NODE,U,3),"&","")_U_CODE_U_$P(SAS(CODE),U,2)
I '$D(CODES) Q
D ASK(.CODES,VISIT)
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
ASK(CODES,VISIT) ;
N CNT,DIR,DONE,I,IDX,IOINHI,IOINORM,NODE,NOTFILED,TYPI,TYPSEQ,CTS,X,PXVST,PXEOCNUM,PXANS,SEQ,SIDX,Y
N CNT,DIR,DONE,DIRUT,DTOUT,DUOUT,IDX,IOINHI,IOINORM,NODE,NOTFILED,SEQ,SIDX,X,Y
S X="IOINHI;IOINORM" D ENDR^%ZISS
W !!,"--- ",IOINHI,"Classification",IOINORM," --- [",IOINHI,"Required",IOINORM,"]"
W !
S PXVST=$P($G(X0),U,5) I 'PXVST,($G(PXCECAT)="VST")!($G(PXCECAT)="SIT") Q
S DIR(0)="Y",CNT=0
S SEQ=0,DONE=0 F S SEQ=$O(CODES(SEQ)) Q:SEQ'>0!(DONE=1) D
.S NODE=CODES(SEQ)
.S DIR("A")="Was treatment related to "_$P(NODE,U,2)_" condition"
.S DIR("B")=$S($P(NODE,U,4)=1:"Yes",1:"No")
.D ^DIR
.I $D(DTOUT)!($D(DUOUT))!($D(DIRUT)) S DONE=1 Q
.I ($G(PXCECAT)="VST")!($G(PXCECAT)="SIT") D Q
..I +$G(VISIT)>0 D
...I '$D(^AUPNVSIT(VISIT,900)) S CNT=CNT+1,PXBDATA(CNT,0)=$P(NODE,U)_U_Y Q
...S SIDX=$P($P(NODE,U),";") S IDX=+$O(^AUPNVSIT(VISIT,900,"B",SIDX,"")) I IDX=0 S NOTFILED($P(NODE,U)_U_Y)="" Q
...S PXBDATA(IDX,0)=$P(NODE,U)_U_Y
..I '$D(NOTFILED) Q
..S CNT=+$O(^AUPNVSIT(VISIT,900,""))
..S NODE="" F S NODE=$O(NOTFILED(NODE)) Q:NODE="" S CNT=CNT+1,PXBDATA(CNT,0)=NODE
.S CNT=CNT+1,PXBDATA(CNT,0)=$P(NODE,U)_U_Y
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 6209 printed Jul 11, 2026@02:22:42 Page 2
PXBAPI21 ;ISL/DCM - API for Classification check out ;Aug 04, 2025@11:51:40
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**130,147,124,184,168,235,240,244**;Aug 12, 1996;Build 37
+2 ; Reference to ^SCE(DA,0) in ICR #402
+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 ;
+12 ; In ^PXBAPI22 which is called by PXBAPI21 (not documented in ^PXBAPI22)
+13 ; Reference to ^DG(43,1,"SCLR") piece 24 in ICR #2085
+14 ; Reference to ^SD(409.41,DA,0), ^SD(409.41,DA,2) in ICR #2083
+15 ; Reference to VAL^SDCODD in ICR #2025
+16 ; Reference to SC^SDCO23 in ICR #2468
+17 ; Reference to ^DPT(D0,"S", in ICR #1301
+18 ;
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 CODE,CODES,IEN,IFN,NODE,PXDIAG,SAS,SDCLOEY,SEQ,ORG,END,DA,X,SIDX,SQUIT
+27 ;PX*1.0*240 removed dot structure to ensure proper command flow
IF $GET(ENCOWNTR)
if '$DATA(^SCE(+ENCOWNTR,0))
QUIT
NEW APTDT,DFN,LOC
SET END=0
SET X0=^SCE(+ENCOWNTR,0)
DO ENCHK(ENCOWNTR,X0)
if END
QUIT
GOTO ON
+28 if '$GET(DFN)!'$GET(LOC)!'$GET(APTDT)
QUIT
+29 SET X=$GET(^DPT(DFN,"S",APTDT,0))
+30 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
+31 SET END=0
DO OPCHK(DFN,LOC,APTDT)
IF END
QUIT
+32 IF +$GET(VISIT)=0
SET VISIT=$PIECE($GET(^SCE(+ENCOWNTR,0)),U,5)
ON ;D ASKCL($G(ENCOWNTR),.SDCLOEY,DFN,APTDT)
+1 ;PX*1.0*235 moved to ON tag
DO SC^PXCEVFI2(DFN)
+2 DO GETPATSA^PXSPECAUTH(DFN,APTDT,LOC,VISIT,.SAS)
+3 SET CODE=""
FOR
SET CODE=$ORDER(SAS(CODE))
if CODE=""
QUIT
Begin DoDot:1
+4 IF +$PIECE(SAS(CODE),U)=0
QUIT
+5 SET SIDX=+$ORDER(^PXIND(820,"C",CODE,""))
IF SIDX=0
QUIT
+6 SET NODE=$GET(^PXIND(820,SIDX,0))
SET SEQ=$PIECE(NODE,U,4)
+7 IF CODE="SC"
IF $PIECE(SAS(CODE),U,2)=""
IF +$$SC^SDSCAPI(DFN,.PXDIAG,ENCOWNTR,$GET(VISIT))>0
SET $PIECE(SAS(CODE),U,2)=1
+8 SET CODES(SEQ)=SIDX_U_$TRANSLATE($PIECE(NODE,U,3),"&","")_U_CODE_U_$PIECE(SAS(CODE),U,2)
End DoDot:1
+9 IF '$DATA(CODES)
QUIT
+10 DO ASK(.CODES,VISIT)
+11 QUIT
+12 ;
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
+4 ;ASK(ENCOWNTR,SDCLOEY,SQUIT) ;Ask classifications
ASK(CODES,VISIT) ;
+1 NEW CNT,DIR,DONE,I,IDX,IOINHI,IOINORM,NODE,NOTFILED,TYPI,TYPSEQ,CTS,X,PXVST,PXEOCNUM,PXANS,SEQ,SIDX,Y
+2 NEW CNT,DIR,DONE,DIRUT,DTOUT,DUOUT,IDX,IOINHI,IOINORM,NODE,NOTFILED,SEQ,SIDX,X,Y
+3 SET X="IOINHI;IOINORM"
DO ENDR^%ZISS
+4 WRITE !!,"--- ",IOINHI,"Classification",IOINORM," --- [",IOINHI,"Required",IOINORM,"]"
+5 WRITE !
+6 SET PXVST=$PIECE($GET(X0),U,5)
IF 'PXVST
IF ($GET(PXCECAT)="VST")!($GET(PXCECAT)="SIT")
QUIT
+7 SET DIR(0)="Y"
SET CNT=0
+8 SET SEQ=0
SET DONE=0
FOR
SET SEQ=$ORDER(CODES(SEQ))
if SEQ'>0!(DONE=1)
QUIT
Begin DoDot:1
+9 SET NODE=CODES(SEQ)
+10 SET DIR("A")="Was treatment related to "_$PIECE(NODE,U,2)_" condition"
+11 SET DIR("B")=$SELECT($PIECE(NODE,U,4)=1:"Yes",1:"No")
+12 DO ^DIR
+13 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
SET DONE=1
QUIT
+14 IF ($GET(PXCECAT)="VST")!($GET(PXCECAT)="SIT")
Begin DoDot:2
+15 IF +$GET(VISIT)>0
Begin DoDot:3
+16 IF '$DATA(^AUPNVSIT(VISIT,900))
SET CNT=CNT+1
SET PXBDATA(CNT,0)=$PIECE(NODE,U)_U_Y
QUIT
+17 SET SIDX=$PIECE($PIECE(NODE,U),";")
SET IDX=+$ORDER(^AUPNVSIT(VISIT,900,"B",SIDX,""))
IF IDX=0
SET NOTFILED($PIECE(NODE,U)_U_Y)=""
QUIT
+18 SET PXBDATA(IDX,0)=$PIECE(NODE,U)_U_Y
End DoDot:3
+19 IF '$DATA(NOTFILED)
QUIT
+20 SET CNT=+$ORDER(^AUPNVSIT(VISIT,900,""))
+21 SET NODE=""
FOR
SET NODE=$ORDER(NOTFILED(NODE))
if NODE=""
QUIT
SET CNT=CNT+1
SET PXBDATA(CNT,0)=NODE
End DoDot:2
QUIT
+22 SET CNT=CNT+1
SET PXBDATA(CNT,0)=$PIECE(NODE,U)_U_Y
End DoDot:1
+23 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
