- PXBAPI21 ;ISL/DCM - API for Classification check out ; 04/16/24 01:49pm
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**130,147,124,184,168,235,240**;Aug 12, 1996;Build 55
- ; 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
- ;
- ; 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
- ;
- 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)) 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
- 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 6764 printed Jan 18, 2025@03:27:22 Page 2
- PXBAPI21 ;ISL/DCM - API for Classification check out ; 04/16/24 01:49pm
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**130,147,124,184,168,235,240**;Aug 12, 1996;Build 55
- +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 ;
- +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 ;
- 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*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
- 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