- 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 Feb 19, 2025@00:25:36 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 ;