SDOEOE ;ALB/MJK - ACRP APIs For An Encounter ;8/12/96
;;5.3;Scheduling;**131,132**;Aug 13, 1993
;
OE0(SDOE) ; -- get only supported 0th node fields
Q $$OE0^SDOEQ(.SDOE) ; -- in SDOEQ for SCAN speed reasons
;
;
GETOE(SDOE,SDERR) ; -- SDOE GET ZERO NODE
; API ID: 98
;
;
Q $S($$VALOE(.SDOE,$G(SDERR)):$$OE0^SDOEQ(.SDOE),1:"")
;
;
GETGEN(SDOE,SDAT,SDERR) ; -- SDOE GET GENERAL DATA
; API ID: 76
;
;
GETGENG ; -- goto entry point
; -- do validation checks
IF '$$VALOE(.SDOE,$G(SDERR)) G GETGENQ
;
S @SDAT=SDOE
S @SDAT@(0)=$$OE0^SDOEQ(.SDOE)
GETGENQ Q
;
;
PARSE(SDATA,SDFMT,SDY,SDERR) ; -- SDOE PARSE GENERAL DATA
; API ID: 78
;
;
PARSEG ; -- goto entry point
; -- do validation checks
; -- invalid format check
IF '$$VALFMT(SDFMT,$G(SDERR)) G PARSEQ
;
; -- no data check
IF $G(SDATA(0))="" D G PARSEQ
. D BLD^SDQVAL(4096800.024,"","",$G(SDERR))
;
IF SDFMT="EXTERNAL" D G PARSEQ
. N SDX S SDX=$G(SDATA(0))
. S @SDY@(.01)=$$FMTE^XLFDT($P(SDX,"^",1))
. S @SDY@(.02)=$P($G(^DPT(+$P(SDX,"^",2),0)),"^")
. S @SDY@(.03)=$P($G(^DIC(40.7,+$P(SDX,"^",3),0)),"^")
. S @SDY@(.04)=$P($G(^SC(+$P(SDX,"^",4),0)),"^")
. S @SDY@(.05)=$$FMTE^XLFDT($P($G(^AUPNVSIT(+$P(SDX,"^",5),0)),"^"))
. S @SDY@(.06)=$$FMTE^XLFDT($P($G(^SCE(+$P(SDX,"^",6),0)),"^"))
. S @SDY@(.07)=$$FMTE^XLFDT($P(SDX,"^",7))
. ;
. S X=$P(SDX,"^",8)
. S @SDY@(.08)=$S(X=1:"APPOINTMENT",X=2:"STOP CODE ADDITION",X=3:"DISPOSITION",X=4:"CREDIT STOP CODE",1:"")
. ;
. ; S @SDY@(.09)=$P(SDX,"^",9) ; -- extended reference not supported
. S @SDY@(.1)=$P($G(^SD(409.1,+$P(SDX,"^",10),0)),"^")
. S @SDY@(.11)=$P($G(^DG(40.8,+$P(SDX,"^",11),0)),"^")
. S @SDY@(.12)=$P($G(^SD(409.63,+$P(SDX,"^",12),0)),"^")
. S @SDY@(.13)=$P($G(^DIC(8,+$P(SDX,"^",13),0)),"^")
;
;
IF SDFMT="INTERNAL" D G PARSEQ
. N SDX S SDX=$G(SDATA(0))
. S @SDY@(.01)=$P(SDX,"^",1)
. S @SDY@(.02)=$P(SDX,"^",2)
. S @SDY@(.03)=$P(SDX,"^",3)
. S @SDY@(.04)=$P(SDX,"^",4)
. S @SDY@(.05)=$P(SDX,"^",5)
. S @SDY@(.06)=$P(SDX,"^",6)
. S @SDY@(.07)=$P(SDX,"^",7)
. S @SDY@(.08)=$P(SDX,"^",8)
. ;S @SDY@(.09)=$P(SDX,"^",9) ; -- extended reference not supported
. S @SDY@(.1)=$P(SDX,"^",10)
. S @SDY@(.11)=$P(SDX,"^",11)
. S @SDY@(.12)=$P(SDX,"^",12)
. S @SDY@(.13)=$P(SDX,"^",13)
;
PARSEQ Q
;
;
EXAE(DFN,SDBEG,SDEND,SDFLAGS,SDERR) ; -- SDOE FIND FIRST STANDALONE
; API ID: 72
;
N SDOE,SDE,X,SDT,SDQUIT
S SDOE=""
;
; -- do validation checks
IF '$$PAT^SDQVAL(.DFN,$G(SDERR)) G EXAEQ
IF '$$RANGE^SDQVAL(.SDBEG,.SDEND,$G(SDERR)) G EXAEQ
;
S SDQUIT=0
S SDT=SDBEG-.000001,SDE=SDEND+$S($P(SDEND,".",2)="":.24,1:"")
F S SDT=$O(^SCE("ADFN",DFN,SDT)) Q:'SDT!(SDT>SDE) D Q:SDQUIT
. S SDOE=0 F S SDOE=$O(^SCE("ADFN",DFN,SDT,SDOE)) Q:'SDOE D Q:SDQUIT
. . S X=$$OE0^SDOEQ(.SDOE)
. . IF $G(SDFLAGS)["C",'$P(X,"^",7) Q ; quit if not "C"ompleted
. . IF $P(X,"^",6) Q ; Parents only
. . IF $P(X,"^",8)'=2 Q ; Stop code addition only
. . S SDQUIT=1 ; Quit after one hit
;
EXAEQ Q SDOE
;
;
GETLAST(DFN,SDBEG,SDFLAGS,SDERR) ; -- SDOE FIND LAST STANDALONE
; API ID: 75
;
N SDOE,SDE,X,SDT,SDQUIT,SDEND
S SDOE="",SDEND=9999999
;
; -- do validation checks
IF '$$PAT^SDQVAL(.DFN,$G(SDERR)) G GETLASTQ
IF '$$RANGE^SDQVAL(.SDBEG,.SDEND,$G(SDERR)) G GETLASTQ
;
S SDQUIT=0
S SDT=SDEND
F S SDT=$O(^SCE("ADFN",DFN,SDT),-1) Q:'SDT!(SDT<SDBEG) D Q:SDQUIT
. S SDOE="" F S SDOE=$O(^SCE("ADFN",DFN,SDT,SDOE),-1) Q:'SDOE D Q:SDQUIT
. . S X=$$OE0^SDOEQ(.SDOE)
. . IF $G(SDFLAGS)["C",'$P(X,"^",7) Q ; quit if not "C"ompleted
. . IF $P(X,"^",6) Q ; Parents only
. . IF $P(X,"^",8)'=2 Q ; Stop code addition only
. . S SDQUIT=1 ; Quit after one hit
;
GETLASTQ Q SDOE
;
;
EXOE(DFN,SDBEG,SDEND,SDFLAGS,SDERR) ; -- SDOE FIND FIRST ENCOUNTER
; API ID: 74
;
N SDOE,SDE,X,SDT,SDQUIT
S SDOE=""
;
; -- do validation checks
IF '$$PAT^SDQVAL(.DFN,$G(SDERR)) G EXOEQ
IF '$$RANGE^SDQVAL(.SDBEG,.SDEND,$G(SDERR)) G EXOEQ
;
S SDQUIT=0
S SDT=SDBEG-.000001,SDE=SDEND+$S($P(SDEND,".",2)="":.24,1:"")
F S SDT=$O(^SCE("ADFN",DFN,SDT)) Q:'SDT!(SDT>SDE) D Q:SDQUIT
. S SDOE=0 F S SDOE=$O(^SCE("ADFN",DFN,SDT,SDOE)) Q:'SDOE D Q:SDQUIT
. . S X=$$OE0^SDOEQ(.SDOE)
. . IF $G(SDFLAGS)["C",'$P(X,"^",7) Q ; quit if not "C"ompleted
. . S SDQUIT=1 ; Quit after one hit
;
EXOEQ Q SDOE
;
;
VALOE(SDOE,SDERR) ; -- validate sdoe input
;
; -- do checks
IF SDOE,$D(^SCE(SDOE,0)) Q 1
;
; -- build error msg
N SDIN,SDOUT
S SDIN("ID")=SDOE
S SDOUT("ID")=SDOE
D BLD^SDQVAL(4096800.001,.SDIN,.SDOUT,$G(SDERR))
Q 0
;
;
VALFMT(SDFMT,SDERR) ; -- validate return format
;
; -- do checks
IF SDFMT="EXTERNAL"!(SDFMT="INTERNAL") Q 1
;
; -- build error msg
N SDIN,SDOUT
S SDIN("FORMAT")=SDFMT
S SDOUT("FORMAT")=SDFMT
D BLD^SDQVAL(4096800.023,.SDIN,.SDOUT,$G(SDERR))
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDOEOE 5102 printed Oct 16, 2024@18:59:29 Page 2
SDOEOE ;ALB/MJK - ACRP APIs For An Encounter ;8/12/96
+1 ;;5.3;Scheduling;**131,132**;Aug 13, 1993
+2 ;
OE0(SDOE) ; -- get only supported 0th node fields
+1 ; -- in SDOEQ for SCAN speed reasons
QUIT $$OE0^SDOEQ(.SDOE)
+2 ;
+3 ;
GETOE(SDOE,SDERR) ; -- SDOE GET ZERO NODE
+1 ; API ID: 98
+2 ;
+3 ;
+4 QUIT $SELECT($$VALOE(.SDOE,$GET(SDERR)):$$OE0^SDOEQ(.SDOE),1:"")
+5 ;
+6 ;
GETGEN(SDOE,SDAT,SDERR) ; -- SDOE GET GENERAL DATA
+1 ; API ID: 76
+2 ;
+3 ;
GETGENG ; -- goto entry point
+1 ; -- do validation checks
+2 IF '$$VALOE(.SDOE,$GET(SDERR))
GOTO GETGENQ
+3 ;
+4 SET @SDAT=SDOE
+5 SET @SDAT@(0)=$$OE0^SDOEQ(.SDOE)
GETGENQ QUIT
+1 ;
+2 ;
PARSE(SDATA,SDFMT,SDY,SDERR) ; -- SDOE PARSE GENERAL DATA
+1 ; API ID: 78
+2 ;
+3 ;
PARSEG ; -- goto entry point
+1 ; -- do validation checks
+2 ; -- invalid format check
+3 IF '$$VALFMT(SDFMT,$GET(SDERR))
GOTO PARSEQ
+4 ;
+5 ; -- no data check
+6 IF $GET(SDATA(0))=""
Begin DoDot:1
+7 DO BLD^SDQVAL(4096800.024,"","",$GET(SDERR))
End DoDot:1
GOTO PARSEQ
+8 ;
+9 IF SDFMT="EXTERNAL"
Begin DoDot:1
+10 NEW SDX
SET SDX=$GET(SDATA(0))
+11 SET @SDY@(.01)=$$FMTE^XLFDT($PIECE(SDX,"^",1))
+12 SET @SDY@(.02)=$PIECE($GET(^DPT(+$PIECE(SDX,"^",2),0)),"^")
+13 SET @SDY@(.03)=$PIECE($GET(^DIC(40.7,+$PIECE(SDX,"^",3),0)),"^")
+14 SET @SDY@(.04)=$PIECE($GET(^SC(+$PIECE(SDX,"^",4),0)),"^")
+15 SET @SDY@(.05)=$$FMTE^XLFDT($PIECE($GET(^AUPNVSIT(+$PIECE(SDX,"^",5),0)),"^"))
+16 SET @SDY@(.06)=$$FMTE^XLFDT($PIECE($GET(^SCE(+$PIECE(SDX,"^",6),0)),"^"))
+17 SET @SDY@(.07)=$$FMTE^XLFDT($PIECE(SDX,"^",7))
+18 ;
+19 SET X=$PIECE(SDX,"^",8)
+20 SET @SDY@(.08)=$SELECT(X=1:"APPOINTMENT",X=2:"STOP CODE ADDITION",X=3:"DISPOSITION",X=4:"CREDIT STOP CODE",1:"")
+21 ;
+22 ; S @SDY@(.09)=$P(SDX,"^",9) ; -- extended reference not supported
+23 SET @SDY@(.1)=$PIECE($GET(^SD(409.1,+$PIECE(SDX,"^",10),0)),"^")
+24 SET @SDY@(.11)=$PIECE($GET(^DG(40.8,+$PIECE(SDX,"^",11),0)),"^")
+25 SET @SDY@(.12)=$PIECE($GET(^SD(409.63,+$PIECE(SDX,"^",12),0)),"^")
+26 SET @SDY@(.13)=$PIECE($GET(^DIC(8,+$PIECE(SDX,"^",13),0)),"^")
End DoDot:1
GOTO PARSEQ
+27 ;
+28 ;
+29 IF SDFMT="INTERNAL"
Begin DoDot:1
+30 NEW SDX
SET SDX=$GET(SDATA(0))
+31 SET @SDY@(.01)=$PIECE(SDX,"^",1)
+32 SET @SDY@(.02)=$PIECE(SDX,"^",2)
+33 SET @SDY@(.03)=$PIECE(SDX,"^",3)
+34 SET @SDY@(.04)=$PIECE(SDX,"^",4)
+35 SET @SDY@(.05)=$PIECE(SDX,"^",5)
+36 SET @SDY@(.06)=$PIECE(SDX,"^",6)
+37 SET @SDY@(.07)=$PIECE(SDX,"^",7)
+38 SET @SDY@(.08)=$PIECE(SDX,"^",8)
+39 ;S @SDY@(.09)=$P(SDX,"^",9) ; -- extended reference not supported
+40 SET @SDY@(.1)=$PIECE(SDX,"^",10)
+41 SET @SDY@(.11)=$PIECE(SDX,"^",11)
+42 SET @SDY@(.12)=$PIECE(SDX,"^",12)
+43 SET @SDY@(.13)=$PIECE(SDX,"^",13)
End DoDot:1
GOTO PARSEQ
+44 ;
PARSEQ QUIT
+1 ;
+2 ;
EXAE(DFN,SDBEG,SDEND,SDFLAGS,SDERR) ; -- SDOE FIND FIRST STANDALONE
+1 ; API ID: 72
+2 ;
+3 NEW SDOE,SDE,X,SDT,SDQUIT
+4 SET SDOE=""
+5 ;
+6 ; -- do validation checks
+7 IF '$$PAT^SDQVAL(.DFN,$GET(SDERR))
GOTO EXAEQ
+8 IF '$$RANGE^SDQVAL(.SDBEG,.SDEND,$GET(SDERR))
GOTO EXAEQ
+9 ;
+10 SET SDQUIT=0
+11 SET SDT=SDBEG-.000001
SET SDE=SDEND+$SELECT($PIECE(SDEND,".",2)="":.24,1:"")
+12 FOR
SET SDT=$ORDER(^SCE("ADFN",DFN,SDT))
if 'SDT!(SDT>SDE)
QUIT
Begin DoDot:1
+13 SET SDOE=0
FOR
SET SDOE=$ORDER(^SCE("ADFN",DFN,SDT,SDOE))
if 'SDOE
QUIT
Begin DoDot:2
+14 SET X=$$OE0^SDOEQ(.SDOE)
+15 ; quit if not "C"ompleted
IF $GET(SDFLAGS)["C"
IF '$PIECE(X,"^",7)
QUIT
+16 ; Parents only
IF $PIECE(X,"^",6)
QUIT
+17 ; Stop code addition only
IF $PIECE(X,"^",8)'=2
QUIT
+18 ; Quit after one hit
SET SDQUIT=1
End DoDot:2
if SDQUIT
QUIT
End DoDot:1
if SDQUIT
QUIT
+19 ;
EXAEQ QUIT SDOE
+1 ;
+2 ;
GETLAST(DFN,SDBEG,SDFLAGS,SDERR) ; -- SDOE FIND LAST STANDALONE
+1 ; API ID: 75
+2 ;
+3 NEW SDOE,SDE,X,SDT,SDQUIT,SDEND
+4 SET SDOE=""
SET SDEND=9999999
+5 ;
+6 ; -- do validation checks
+7 IF '$$PAT^SDQVAL(.DFN,$GET(SDERR))
GOTO GETLASTQ
+8 IF '$$RANGE^SDQVAL(.SDBEG,.SDEND,$GET(SDERR))
GOTO GETLASTQ
+9 ;
+10 SET SDQUIT=0
+11 SET SDT=SDEND
+12 FOR
SET SDT=$ORDER(^SCE("ADFN",DFN,SDT),-1)
if 'SDT!(SDT<SDBEG)
QUIT
Begin DoDot:1
+13 SET SDOE=""
FOR
SET SDOE=$ORDER(^SCE("ADFN",DFN,SDT,SDOE),-1)
if 'SDOE
QUIT
Begin DoDot:2
+14 SET X=$$OE0^SDOEQ(.SDOE)
+15 ; quit if not "C"ompleted
IF $GET(SDFLAGS)["C"
IF '$PIECE(X,"^",7)
QUIT
+16 ; Parents only
IF $PIECE(X,"^",6)
QUIT
+17 ; Stop code addition only
IF $PIECE(X,"^",8)'=2
QUIT
+18 ; Quit after one hit
SET SDQUIT=1
End DoDot:2
if SDQUIT
QUIT
End DoDot:1
if SDQUIT
QUIT
+19 ;
GETLASTQ QUIT SDOE
+1 ;
+2 ;
EXOE(DFN,SDBEG,SDEND,SDFLAGS,SDERR) ; -- SDOE FIND FIRST ENCOUNTER
+1 ; API ID: 74
+2 ;
+3 NEW SDOE,SDE,X,SDT,SDQUIT
+4 SET SDOE=""
+5 ;
+6 ; -- do validation checks
+7 IF '$$PAT^SDQVAL(.DFN,$GET(SDERR))
GOTO EXOEQ
+8 IF '$$RANGE^SDQVAL(.SDBEG,.SDEND,$GET(SDERR))
GOTO EXOEQ
+9 ;
+10 SET SDQUIT=0
+11 SET SDT=SDBEG-.000001
SET SDE=SDEND+$SELECT($PIECE(SDEND,".",2)="":.24,1:"")
+12 FOR
SET SDT=$ORDER(^SCE("ADFN",DFN,SDT))
if 'SDT!(SDT>SDE)
QUIT
Begin DoDot:1
+13 SET SDOE=0
FOR
SET SDOE=$ORDER(^SCE("ADFN",DFN,SDT,SDOE))
if 'SDOE
QUIT
Begin DoDot:2
+14 SET X=$$OE0^SDOEQ(.SDOE)
+15 ; quit if not "C"ompleted
IF $GET(SDFLAGS)["C"
IF '$PIECE(X,"^",7)
QUIT
+16 ; Quit after one hit
SET SDQUIT=1
End DoDot:2
if SDQUIT
QUIT
End DoDot:1
if SDQUIT
QUIT
+17 ;
EXOEQ QUIT SDOE
+1 ;
+2 ;
VALOE(SDOE,SDERR) ; -- validate sdoe input
+1 ;
+2 ; -- do checks
+3 IF SDOE
IF $DATA(^SCE(SDOE,0))
QUIT 1
+4 ;
+5 ; -- build error msg
+6 NEW SDIN,SDOUT
+7 SET SDIN("ID")=SDOE
+8 SET SDOUT("ID")=SDOE
+9 DO BLD^SDQVAL(4096800.001,.SDIN,.SDOUT,$GET(SDERR))
+10 QUIT 0
+11 ;
+12 ;
VALFMT(SDFMT,SDERR) ; -- validate return format
+1 ;
+2 ; -- do checks
+3 IF SDFMT="EXTERNAL"!(SDFMT="INTERNAL")
QUIT 1
+4 ;
+5 ; -- build error msg
+6 NEW SDIN,SDOUT
+7 SET SDIN("FORMAT")=SDFMT
+8 SET SDOUT("FORMAT")=SDFMT
+9 DO BLD^SDQVAL(4096800.023,.SDIN,.SDOUT,$GET(SDERR))
+10 QUIT 0
+11 ;
