Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDOEOE

SDOEOE.m

Go to the documentation of this file.
  1. SDOEOE ;ALB/MJK - ACRP APIs For An Encounter ;8/12/96
  1. ;;5.3;Scheduling;**131,132**;Aug 13, 1993
  1. ;
  1. OE0(SDOE) ; -- get only supported 0th node fields
  1. Q $$OE0^SDOEQ(.SDOE) ; -- in SDOEQ for SCAN speed reasons
  1. ;
  1. ;
  1. GETOE(SDOE,SDERR) ; -- SDOE GET ZERO NODE
  1. ; API ID: 98
  1. ;
  1. ;
  1. Q $S($$VALOE(.SDOE,$G(SDERR)):$$OE0^SDOEQ(.SDOE),1:"")
  1. ;
  1. ;
  1. GETGEN(SDOE,SDAT,SDERR) ; -- SDOE GET GENERAL DATA
  1. ; API ID: 76
  1. ;
  1. ;
  1. GETGENG ; -- goto entry point
  1. ; -- do validation checks
  1. IF '$$VALOE(.SDOE,$G(SDERR)) G GETGENQ
  1. ;
  1. S @SDAT=SDOE
  1. S @SDAT@(0)=$$OE0^SDOEQ(.SDOE)
  1. GETGENQ Q
  1. ;
  1. ;
  1. PARSE(SDATA,SDFMT,SDY,SDERR) ; -- SDOE PARSE GENERAL DATA
  1. ; API ID: 78
  1. ;
  1. ;
  1. PARSEG ; -- goto entry point
  1. ; -- do validation checks
  1. ; -- invalid format check
  1. IF '$$VALFMT(SDFMT,$G(SDERR)) G PARSEQ
  1. ;
  1. ; -- no data check
  1. IF $G(SDATA(0))="" D G PARSEQ
  1. . D BLD^SDQVAL(4096800.024,"","",$G(SDERR))
  1. ;
  1. IF SDFMT="EXTERNAL" D G PARSEQ
  1. . N SDX S SDX=$G(SDATA(0))
  1. . S @SDY@(.01)=$$FMTE^XLFDT($P(SDX,"^",1))
  1. . S @SDY@(.02)=$P($G(^DPT(+$P(SDX,"^",2),0)),"^")
  1. . S @SDY@(.03)=$P($G(^DIC(40.7,+$P(SDX,"^",3),0)),"^")
  1. . S @SDY@(.04)=$P($G(^SC(+$P(SDX,"^",4),0)),"^")
  1. . S @SDY@(.05)=$$FMTE^XLFDT($P($G(^AUPNVSIT(+$P(SDX,"^",5),0)),"^"))
  1. . S @SDY@(.06)=$$FMTE^XLFDT($P($G(^SCE(+$P(SDX,"^",6),0)),"^"))
  1. . S @SDY@(.07)=$$FMTE^XLFDT($P(SDX,"^",7))
  1. . ;
  1. . S X=$P(SDX,"^",8)
  1. . S @SDY@(.08)=$S(X=1:"APPOINTMENT",X=2:"STOP CODE ADDITION",X=3:"DISPOSITION",X=4:"CREDIT STOP CODE",1:"")
  1. . ;
  1. . ; S @SDY@(.09)=$P(SDX,"^",9) ; -- extended reference not supported
  1. . S @SDY@(.1)=$P($G(^SD(409.1,+$P(SDX,"^",10),0)),"^")
  1. . S @SDY@(.11)=$P($G(^DG(40.8,+$P(SDX,"^",11),0)),"^")
  1. . S @SDY@(.12)=$P($G(^SD(409.63,+$P(SDX,"^",12),0)),"^")
  1. . S @SDY@(.13)=$P($G(^DIC(8,+$P(SDX,"^",13),0)),"^")
  1. ;
  1. ;
  1. IF SDFMT="INTERNAL" D G PARSEQ
  1. . N SDX S SDX=$G(SDATA(0))
  1. . S @SDY@(.01)=$P(SDX,"^",1)
  1. . S @SDY@(.02)=$P(SDX,"^",2)
  1. . S @SDY@(.03)=$P(SDX,"^",3)
  1. . S @SDY@(.04)=$P(SDX,"^",4)
  1. . S @SDY@(.05)=$P(SDX,"^",5)
  1. . S @SDY@(.06)=$P(SDX,"^",6)
  1. . S @SDY@(.07)=$P(SDX,"^",7)
  1. . S @SDY@(.08)=$P(SDX,"^",8)
  1. . ;S @SDY@(.09)=$P(SDX,"^",9) ; -- extended reference not supported
  1. . S @SDY@(.1)=$P(SDX,"^",10)
  1. . S @SDY@(.11)=$P(SDX,"^",11)
  1. . S @SDY@(.12)=$P(SDX,"^",12)
  1. . S @SDY@(.13)=$P(SDX,"^",13)
  1. ;
  1. PARSEQ Q
  1. ;
  1. ;
  1. EXAE(DFN,SDBEG,SDEND,SDFLAGS,SDERR) ; -- SDOE FIND FIRST STANDALONE
  1. ; API ID: 72
  1. ;
  1. N SDOE,SDE,X,SDT,SDQUIT
  1. S SDOE=""
  1. ;
  1. ; -- do validation checks
  1. IF '$$PAT^SDQVAL(.DFN,$G(SDERR)) G EXAEQ
  1. IF '$$RANGE^SDQVAL(.SDBEG,.SDEND,$G(SDERR)) G EXAEQ
  1. ;
  1. S SDQUIT=0
  1. S SDT=SDBEG-.000001,SDE=SDEND+$S($P(SDEND,".",2)="":.24,1:"")
  1. F S SDT=$O(^SCE("ADFN",DFN,SDT)) Q:'SDT!(SDT>SDE) D Q:SDQUIT
  1. . S SDOE=0 F S SDOE=$O(^SCE("ADFN",DFN,SDT,SDOE)) Q:'SDOE D Q:SDQUIT
  1. . . S X=$$OE0^SDOEQ(.SDOE)
  1. . . IF $G(SDFLAGS)["C",'$P(X,"^",7) Q ; quit if not "C"ompleted
  1. . . IF $P(X,"^",6) Q ; Parents only
  1. . . IF $P(X,"^",8)'=2 Q ; Stop code addition only
  1. . . S SDQUIT=1 ; Quit after one hit
  1. ;
  1. EXAEQ Q SDOE
  1. ;
  1. ;
  1. GETLAST(DFN,SDBEG,SDFLAGS,SDERR) ; -- SDOE FIND LAST STANDALONE
  1. ; API ID: 75
  1. ;
  1. N SDOE,SDE,X,SDT,SDQUIT,SDEND
  1. S SDOE="",SDEND=9999999
  1. ;
  1. ; -- do validation checks
  1. IF '$$PAT^SDQVAL(.DFN,$G(SDERR)) G GETLASTQ
  1. IF '$$RANGE^SDQVAL(.SDBEG,.SDEND,$G(SDERR)) G GETLASTQ
  1. ;
  1. S SDQUIT=0
  1. S SDT=SDEND
  1. F S SDT=$O(^SCE("ADFN",DFN,SDT),-1) Q:'SDT!(SDT<SDBEG) D Q:SDQUIT
  1. . S SDOE="" F S SDOE=$O(^SCE("ADFN",DFN,SDT,SDOE),-1) Q:'SDOE D Q:SDQUIT
  1. . . S X=$$OE0^SDOEQ(.SDOE)
  1. . . IF $G(SDFLAGS)["C",'$P(X,"^",7) Q ; quit if not "C"ompleted
  1. . . IF $P(X,"^",6) Q ; Parents only
  1. . . IF $P(X,"^",8)'=2 Q ; Stop code addition only
  1. . . S SDQUIT=1 ; Quit after one hit
  1. ;
  1. GETLASTQ Q SDOE
  1. ;
  1. ;
  1. EXOE(DFN,SDBEG,SDEND,SDFLAGS,SDERR) ; -- SDOE FIND FIRST ENCOUNTER
  1. ; API ID: 74
  1. ;
  1. N SDOE,SDE,X,SDT,SDQUIT
  1. S SDOE=""
  1. ;
  1. ; -- do validation checks
  1. IF '$$PAT^SDQVAL(.DFN,$G(SDERR)) G EXOEQ
  1. IF '$$RANGE^SDQVAL(.SDBEG,.SDEND,$G(SDERR)) G EXOEQ
  1. ;
  1. S SDQUIT=0
  1. S SDT=SDBEG-.000001,SDE=SDEND+$S($P(SDEND,".",2)="":.24,1:"")
  1. F S SDT=$O(^SCE("ADFN",DFN,SDT)) Q:'SDT!(SDT>SDE) D Q:SDQUIT
  1. . S SDOE=0 F S SDOE=$O(^SCE("ADFN",DFN,SDT,SDOE)) Q:'SDOE D Q:SDQUIT
  1. . . S X=$$OE0^SDOEQ(.SDOE)
  1. . . IF $G(SDFLAGS)["C",'$P(X,"^",7) Q ; quit if not "C"ompleted
  1. . . S SDQUIT=1 ; Quit after one hit
  1. ;
  1. EXOEQ Q SDOE
  1. ;
  1. ;
  1. VALOE(SDOE,SDERR) ; -- validate sdoe input
  1. ;
  1. ; -- do checks
  1. IF SDOE,$D(^SCE(SDOE,0)) Q 1
  1. ;
  1. ; -- build error msg
  1. N SDIN,SDOUT
  1. S SDIN("ID")=SDOE
  1. S SDOUT("ID")=SDOE
  1. D BLD^SDQVAL(4096800.001,.SDIN,.SDOUT,$G(SDERR))
  1. Q 0
  1. ;
  1. ;
  1. VALFMT(SDFMT,SDERR) ; -- validate return format
  1. ;
  1. ; -- do checks
  1. IF SDFMT="EXTERNAL"!(SDFMT="INTERNAL") Q 1
  1. ;
  1. ; -- build error msg
  1. N SDIN,SDOUT
  1. S SDIN("FORMAT")=SDFMT
  1. S SDOUT("FORMAT")=SDFMT
  1. D BLD^SDQVAL(4096800.023,.SDIN,.SDOUT,$G(SDERR))
  1. Q 0
  1. ;