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

SDAPICO1.m

Go to the documentation of this file. 
  1. SDAPICO1 ;ALB/MJK - API - Common Check-Out Processing;04 MAR 1993 10:00 am
  1.  ;;5.3;Scheduling;**27**;08/13/93
  1.  ;
  1. CLASS(SDOE) ; -- file classification data
  1.  IF '$D(@SDROOT@("CLASSIFICATION")) G CLASSQ
  1.  N SDCLOEY,I,SDCTIS,SDCTS,SDVAL,SDCTVAL,SDCT,SDCT0,SDCTI,SDCTAB,SDACT
  1.  ;  -- find class required for this encounter
  1.  D CLASK^SDCO2(SDOE,.SDCLOEY)
  1.  ;
  1.  ; -- get class abbreviations
  1.  S SDCTI=0 F  S SDCTI=$O(^SD(409.41,SDCTI)) Q:'SDCTI  S SDCTAB($P(^(SDCTI,0),U,7))=SDCTI
  1.  ;
  1.  ; -- process deletions
  1.  IF $D(SDCLOEY),$D(@SDROOT@("CLASSIFICATION","DELETE")) D
  1.  . S SDCT=""
  1.  . F  S SDCT=$O(@SDROOT@("CLASSIFICATION","DELETE",SDCT)) Q:SDCT=""  D
  1.  .. ; -- valid class
  1.  .. S SDCTI=$$VALID(SDCT,.SDCTAB) Q:'SDCTI
  1.  .. ; -- delete co completion date ; delete class entry ; send warning
  1.  .. D COMDT^SDCODEL(SDOE),DEL^SDAPICO(SDOE,409.42,SDCTI),ERRFILE^SDAPIER(1045)
  1.  ;
  1.  ; -- warning if class data not required but passed
  1.  IF '$D(SDCLOEY),$D(@SDROOT@("CLASSIFICATION","ADD"))!($D(@SDROOT@("CLASSIFICATION","CHANGE"))) D ERRFILE^SDAPIER(1040) G CLASSQ
  1.  ;
  1.  F SDACT="ADD","CHANGE" D
  1.  . S SDCT=""
  1.  . F  S SDCT=$O(@SDROOT@("CLASSIFICATION",SDACT,SDCT)) Q:SDCT=""  D
  1.  .. S SDVAL=@SDROOT@("CLASSIFICATION",SDACT,SDCT)
  1.  .. ; -- valid class abbrev passed
  1.  .. S SDCTI=$$VALID(SDCT,.SDCTAB) Q:'SDCTI
  1.  .. ; -- vaild format for class value passed
  1.  .. S SDCT0=$G(^SD(409.41,SDCTI,0))
  1.  .. IF '$$CHKVAL(SDCT0,.SDVAL) D ERRFILE^SDAPIER(1044,$P(SDCT0,U)_U_SDVAL) Q
  1.  .. S SDCTVAL(SDCTI)=SDVAL
  1.  .. ; -- if change to sc class then delete c/o process date & send warning
  1.  .. IF SDCTI=3,$G(SDCLOEY(3)),$P(SDCLOEY(3),U,2)]"",SDCTVAL(3)'=$P(SDCLOEY(3),U,2) D COMDT^SDCODEL(SDOE),ERRFILE^SDAPIER(1046)
  1.  ;
  1.  ; -- get required sequence to file class (ie. force sc to be 1st)
  1.  S SDCTIS=$$SEQ^SDCO21
  1.  F SDCTS=1:1 S SDCTI=+$P(SDCTIS,",",SDCTS) Q:'SDCTI!($D(SDCOQUIT))  D
  1.  . ; -- check to see if specific class is needed
  1.  . IF $D(SDCTVAL(SDCTI)),'$D(SDCLOEY(SDCTI)) D ERRFILE^SDAPIER(1047,$P($G(^SD(409.41,SDCTI,0)),U,7)) Q
  1.  . ; process specific class
  1.  . IF $D(SDCLOEY(SDCTI)) D
  1.  .. D ONE(SDCTI,SDCLOEY(SDCTI),SDOE,$G(SDCTVAL(SDCTI)))
  1.  .. ; -- if service connected class do consistency checks
  1.  .. IF SDCTI=3 F I=1,2,4 D SC^SDCO21(I,SDOE,"",.SDCLOEY)
  1. CLASSQ Q
  1.  ;
  1. VALID(SDCT,SDCTAB) ; -- warning if not a valid class passed
  1.  N SDCTI
  1.  S SDCTI=+$G(SDCTAB(SDCT))
  1.  IF 'SDCTI D ERRFILE^SDAPIER(1041,SDCT)
  1.  Q SDCTI
  1.  ;
  1. ONE(SDCTI,SDATA,SDOE,SDVAL) ;Process One Classification at a time
  1.  ; Input  -- SDCTI    Outpatient Classification Type IEN
  1.  ;           SDATA    Null or 409.42 IEN^Internal Value^1=n/a^1=unedt
  1.  ;           SDOE     Outpatient Encounter file IEN
  1.  ; Output -- <none>
  1.  ;
  1.  N SDCT0,DIK,DA
  1.  S SDCT0=$G(^SD(409.41,SDCTI,0)) G ONEQ:SDCT0']""
  1.  ; -- no longer applicable
  1.  IF SDATA,$P(SDATA,"^",3) D  G ONEQ
  1.  . N DIK,DA
  1.  . S DA=+SDATA,DIK="^SDD(409.42," D ^DIK
  1.  . D ERRFILE^SDAPIER(1042,$P(SDCT0,U))
  1.  ; --  uneditable
  1.  IF SDATA,$P(SDATA,"^",4) D ERRFILE^SDAPIER(1043,$P(SDCT0,U)) G ONEQ
  1.  ; -- file data
  1.  IF SDVAL]"" D FILE^SDCO20(+SDATA,SDVAL)
  1. ONEQ Q
  1.  ;
  1. CHKVAL(SDCT0,SDVAL) ; -- validate classification value and convert
  1.  N Y,SDTYPE
  1.  S SDTYPE=$P(SDCT0,U,3),Y=0
  1.  IF SDTYPE="Y",SDVAL="Y"!(SDVAL="N") S Y=1,SDVAL=$S(SDVAL="Y":1,1:0)
  1.  IF SDTYPE="N",SDVAL=+SDVAL S Y=1
  1.  Q Y
  1.  ;