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

APCDALV2.m

Go to the documentation of this file. 
  1. APCDALV2 ; IHS/CMI/LAB - ;
  1.  ;;2.0;IHS PCC SUITE;**5,6**;MAY 14, 2009;Build 11
  1.  ;
  1.  ;
  1. ADDPROB(APCDDX,APCDP,APCDDLM,APCDCLS,APCDN,APCDFAC,APCDDTE,APCDSTAT,APCDDOO,APCDCLAS,APCDEBU,APCDEC1,APCDEC2,APCDEC3) ;PEP called to non-interactively add a problem to the pcc problem list
  1.  ;APCDDX is the dx - pass in "`"_ien format or pass code (required)
  1.  ;APCDP is the patient dfn (required)
  1.  ;APCDDLM is the date last modified, if null I will stuff DT, PASS IN EXTERNAL FORMAT PLEASE
  1.  ;APCDCLS is the class (not required)
  1.  ;APCDN - provider narrative pass either "`"_ien of prov narr or pass narrative text
  1.  ;APCDFAC - facility ien, if null will use DUZ(2)
  1.  ;APCDDTE - date entered, if null will use DT , PASS IN EXTERNAL FORMAT PLEASE
  1.  ;APCDSTAT - status I or A WILL DEFAULT TO A IF NONE PASSED
  1.  ;APCDDOO - date of onset (pass in EXTERNAL  format please) (not required)
  1.  ;APCDCLAS= .15 field
  1.  ;APCDEBU = ENTERED BY (field 1.03) if blank  is stuffed with DUZ
  1.  ;APCDEC1, APCDEC2, APCDEC3 - E CODES pass in "`"_ien format or pass code (required)
  1.  ;
  1.  ;error codes will be past back
  1.  ;    1 = invalid dx, either not a valid ien, inactive code, E code
  1.  ;    2 = invalid patient dfn, either not a valid dfn or patient merged
  1.  ;    3 = invalid class code
  1.  ;    4 = error creating entry with FILE^DICN
  1.  ;    5 = invalid date last modified
  1.  ;    6 = invalid provider narrative
  1.  ;    7 = invalid date entered
  1.  ;    8 = invalid facility
  1.  ;    9 = invalid status
  1.  ;   10 = invalid date of onset
  1.  ;   11 = invalid ecode 1
  1.  ;   12 = invalid ecode 2
  1.  ;   13 = invalid ecode 3
  1.  ;
  1.  NEW APCDERR
  1.  S APCDERR=0
  1.  D EN^XBNEW("AP^APCDALV2","APCDDX;APCDP;APCDDLM;APCDCLS;APCDN;APCDFAC;APCDDTE;APCDSTAT;APCDDOO;APCDCLAS;APCDEBU;APCDERR;APCDEC1;APCDEC2;APCDEC3")
  1.  Q APCDERR
  1.  ;
  1. AP ;EP
  1.  NEW IEN,%,F,%FDA
  1. P I '$G(APCDP) S APCDERR=2 Q
  1.  I '$D(^DPT(APCDP)) S APCDERR=2 Q
  1.  I $P(^DPT(APCDP,0),U,19) S APCDERR=2 Q
  1.  I '$D(^AUPNPAT(APCDP)) S APCDERR=2 Q
  1.  S Y=APCDP D ^AUPNPAT
  1. DX ;DX CHK
  1.  I $G(APCDDX)="" S APCDERR=1 Q
  1.  D CHK^DIE(9000011,.01,"",APCDDX,.%) I %="^" S APCDERR=1 Q
  1.  S APCDDX=%
  1. DLM ;
  1.  I $G(APCDDLM)="" S APCDDLM=$$FMTE^XLFDT(DT,"1D")
  1.  D CHK^DIE(9000011,.03,"",APCDDLM,.%) I %="^" S APCDERR=5 Q
  1. CLS ;
  1.  I $G(APCDCLS)="" S APCDCLS=""
  1.  I APCDCLS]"" D  Q:APCDERR
  1.  .D CHK^DIE(9000011,.04,"",APCDCLS,.%) I %="^" S APCDERR=3 Q
  1. NARR ;
  1.  I $G(APCDN)="" S APCDERR=6 Q
  1.  I $$CHKNARR(APCDN) S APCDERR=6 Q
  1. FAC ;
  1.  I '$G(APCDFAC) S APCDFAC=DUZ(2)
  1.  I '$D(^AUTTLOC(APCDFAC)) S APCDERR=8 Q
  1. DTE ;
  1.  I $G(APCDDTE)="" S APCDDTE=$$FMTE^XLFDT(DT,"1D")
  1.  D CHK^DIE(9000011,.08,"",APCDDTE,.%) I %="^" S APCDERR=7 Q
  1. STATUS ;
  1.  I $G(APCDSTAT)="" S APCDSTAT="A" G DOO
  1.  D CHK^DIE(9000011,.12,"",APCDSTAT,.%) I %="^" S APCDERR=9 Q
  1. DOO ;
  1.  S:$G(APCDDOO)="" APCDDOO="" G CLASS
  1.  D CHK^DIE(9000011,.13,"",APCDDOO,.%) I %="^" S APCDERR=10 Q
  1. CLASS ;
  1.  S APCDCLAS=$G(APCDCLAS)
  1.  S APCDEC1=$G(APCDEC1)
  1.  I APCDEC1]"" D CHK^DIE(9000011,.16,"",APCDEC1,.%) I %="^" S APCDERR=11 Q
  1.  S APCDEC2=$G(APCDEC2)
  1.  I APCDEC2]"" D CHK^DIE(9000011,.17,"",APCDEC2,.%) I %="^" S APCDERR=12 Q
  1.  S APCDEC3=$G(APCDEC3)
  1.  I APCDEC3]"" D CHK^DIE(9000011,.18,"",APCDEC3,.%) I %="^" S APCDERR=13 Q
  1. NMBR ;calculate new number
  1.  NEW X,Y S X=0,Y="" F  S Y=$O(^AUPNPROB("AA",APCDP,APCDFAC,Y)) S:Y'="" X=$E(Y,2,4) I Y="" S X=X+1 K Y Q
  1.  S APCDNMBR=X
  1. FILE ;
  1.  S APCDOVRR=1,APCDALVR=""
  1.  S X=APCDDX,DIC(0)="L",DIC="^AUPNPROB(",DLAYGO=9000011,DIADD=1
  1.  S DIC("DR")=".02////"_APCDP_";.03///"_APCDDLM_";.04///"_APCDCLS_";.05///"_APCDN_";.06////"_APCDFAC_";.08///"_APCDDTE_";.07///"_APCDNMBR_";.12///"_APCDSTAT_";.13///"_APCDDOO_";1.03////"_$S($G(APCDEBU):APCDEBU,1:DUZ)_";.15///"_APCDCLAS
  1.  S DIC("DR")=DIC("DR")_";.16///"_APCDEC1_";.17///"_APCDEC2_";.18///"_APCDEC3
  1.  K DD,DO D FILE^DICN K DD,DO,DR,DLAYGO,DIADD,DIC
  1.  I Y=-1 S APCDERR=4 Q
  1.  Q
  1. CHKNARR(D) ;
  1.  NEW %,F
  1.  S F=0
  1.  I $E(D)="`" S D=$P(D,"`",2) D  Q F
  1.  .I '$D(^AUTNPOV(D)) S F=1
  1.  .;S APCDN=D
  1.  .Q
  1.  S X=D X $P(^DD(9999999.27,.01,0),U,5,99)
  1.  I '$D(X) S F=1
  1.  Q F
  1. DELPROB(P,REASON,OTHER) ;PEP called to delete a problem from the PCC Problem list
  1.  ;non interactive -1 will be returned if a valid problem ien was not passed
  1.  ;sets .12 field to D, sets 2.01 to DUZ, set 2.02 to $$NOW
  1.  ;if passed sets 2.03 to REASON
  1.  ;if passed, sets 2.04 to OTHER
  1.  NEW DA,DIE,DR
  1.  I '$G(P) Q -1
  1.  I '$D(^AUPNPROB(P)) Q -1
  1.  S REASON=$G(REASON)
  1.  S OTHER=$G(OTHER)
  1.  S DA=P  ;,DIK="^AUPNPROB(" D ^DIK
  1.  S DIE="^AUPNPROB("
  1.  S DR=".12////D;2.01////"_DUZ_";2.02///^S X=$$NOW^XLFDT;2.03///"_REASON_";2.04///"_OTHER
  1.  D ^DIE K DA,DR,DIE
  1.  I $D(Y) Q "-1^INVALID DATA"
  1.  Q ""
  1. TEST ;APCDDX,APCDP,APCDDLM,APCDCLS,APCDN,APCDFAC,APCDDTE,APCDSTAT,APCDDOO,APCDCLAS,APCDEBU,APCDEC1,APCDEC2,APCDEC3
  1.  S X=$$ADDPROB(250.00,10,3101111,,"THIS IS MY NARRATIVE",5217,3101111,"A",,"P",,"E000.9","E800.1","E000.0")
  1.  W !,X
  1.  Q
  1. TESTDEL ;
  1.  S X=$$DELPROB(1200,"OTHER","PROBLEM IS RESOLVED")
  1.  W !,X
  1.  Q