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

APCDGAPI.m

Go to the documentation of this file. 
  1. APCDGAPI ;IHS/CMI/LAB - PATIENT GOALS APIs;05-Dec-2011 14:28;DU
  1.  ;;2.0;IHS PCC SUITE;**7,10,11**;MAY 14, 2009;Build 58
  1.  ;
  1.  ;
  1.  ;
  1. ADDGOAL(APCDPT,GDAT,RETVAL) ;PEP -- add Patient Goal
  1.  ;This API is called to add a new entry to the PATIENT GOALS file
  1.  ;Input:
  1.  ;  - APCDPT = Patient DFN
  1.  ;  - DAT = array of field data in the format DAT(field#,counter)=value
  1.  ;               note the counter will always be 1 except for field 1000 which is
  1.  ;               a multiple valued field so the counter will be 1,2 etc.
  1.  ;    Details:
  1.  ;    DAT(".01",1)=this is the goal set status, .01 field value
  1.  ;       (".06",1)=facility where goal was added, optional, if not passed DUZ(2) is used
  1.  ;       (".07",1)=goal number, must be a number 99.999 and must not already be used.  Use
  1.  ;                 "AA" xref to determine allowable goal numbers for this facility:
  1.  ;                  ^AUPNGOAL("AA",1090,5217," 001.00",3)=""
  1.  ;                  ^AUPNGOAL("AA",1090,5217," 002.00",11)=""
  1.  ;       (".08",1)=provider documenting, managing this goal, if not passed, DUZ is used
  1.  ;       (".09",1)=goal start date, required, date only
  1.  ;       (".1",1)=goal followup date, required, date only
  1.  ;       (".12",1)=user last update, if not passed, DUZ will be used
  1.  ;       ("1000",1)=goal type from file PATIENT GOAL TYPES - at least 1 is required, this is a multiple field
  1.  ;       ("1000",2)=goal type 2, etc
  1.  ;       ("1101",1)=goal name, required, free text 2-120 characters
  1.  ;       ("1201",1)=reason for goal, free text 2-120 characters, optional
  1.  ;       note:  field .11 is always stuffed with A (Active) on an add so no need to pass in that field value
  1.  ;       note:  field .02  is always stuffed with the value of APCDPT
  1.  ;       note:  fields .03 and .05 are stuffed with DT and $$NOW
  1.  ;       note:  fields .04 and .12 area stuffed with DUZ
  1.  ;
  1.  ;  - RETVAL = string that returns value of call success/failure
  1.  ;
  1.  ;RETURN VALUE - RETVAL=ien of patient goal entry created OR 0^error message
  1.  ;
  1.  ;
  1.  NEW APCDF,APCDC,APCDFDA,APCDIENS,APCDCNTR,APCDTY,APCDLOC,APCDE,APCDI,APCDLOC,APCDERR,APCDGDAT,APCDSTD,APCDGIEN,APCDEC
  1.  NEW X,Y,%DT,Z,DIC,DIE,DR,DIK
  1.  S RETVAL=""
  1. E02 ;
  1.  I '$G(APCDPT) S RETVAL="0^patient pointer (DFN) invalid" Q
  1.  I '$D(^AUPNPAT(APCDPT)) S RETVAL="0^patient pointer (DFN) invalid" Q
  1. REQ ;these field values are required to create an entry
  1.  F APCDF=".07",".09",".01",".1","1000","1101" I $G(GDAT(APCDF,1))="" S RETVAL="0^"_APCDF_" field value missing, required to create a GOAL"
  1.  I RETVAL]"" Q
  1.  S APCDIENS="+1,"
  1.  ;check all incoming data values and set fda array for call to Update^DIE
  1. E01 ;.01 VALUE
  1.  S APCDI=""
  1.  K APCDE
  1.  S X=GDAT(.01,1) I $L(X)=1 S X=$$EXTERNAL^DILFD(9000093,.01,"",$G(GDAT(".01",1)))
  1.  D VAL^DIE(9000093,APCDIENS,.01,"EF",X,.APCDI,"APCDFDA","APCDE") I $D(APCDE("DIERR",1,"TEXT",1)) D E(APCDE("DIERR",1,"TEXT",1)) Q
  1. E06 ;
  1.  S X=$G(GDAT(.06,1))
  1.  I X="" S X=DUZ(2)
  1.  I X?1.N S X=$$EXTERNAL^DILFD(9000093,".06","",X)
  1.  D VAL^DIE(9000093,APCDIENS,.06,"EF",X,.APCDI,"APCDFDA","APCDE")
  1.  S APCDLOC=APCDI
  1.  I $D(APCDE("DIERR",1,"TEXT",1)) D E(APCDE("DIERR",1,"TEXT",1)) Q
  1. E07 ;
  1.  S X=$G(GDAT(.07,1))
  1.  I +X'=X!(X>999.99)!(X<1)!(X?.E1"."3N.N) S RETVAL="0^Goal number invalid, must be a number between 1-999.99" Q
  1.  S Y=" "_$E("000",1,4-$L($P(X,".",1))-1)_$P(X,".",1)_"."_$P(X,".",2)_$E("00",1,3-$L($P(X,".",2))-1)
  1.  I $D(^AUPNGOAL("AA",APCDPT,APCDLOC,Y)) S RETVAL="0^Goal number already in use - .07 value invalid" Q
  1.  S APCDFDA(9000093,APCDIENS,.07)=X
  1. E08 ;
  1.  S X=$G(GDAT(".08",1))
  1.  I X="" S X=DUZ
  1.  I X?1.N S X=$$EXTERNAL^DILFD(9000093,".08","",X)
  1.  D VAL^DIE(9000093,APCDIENS,.08,"EF",X,.APCDI,"APCDFDA","APCDE")
  1.  I $D(APCDE("DIERR",1,"TEXT",1)) D E(APCDE("DIERR",1,"TEXT",1)) Q
  1. E09 ;
  1.  S X=$G(GDAT(".09",1))
  1.  S %DT=""
  1.  D ^%DT
  1.  I Y=-1 S RETVAL="0^Goal start date invalid" Q
  1.  S APCDFDA(9000093,APCDIENS,.09)=Y
  1.  S APCDSTD=Y
  1. E10 ;
  1.  S X=$G(GDAT(".1",1))
  1.  S %DT=""
  1.  D ^%DT
  1.  I Y=-1 S RETVAL="0^Goal start date invalid" Q
  1.  I Y<APCDSTD S RETVAL="0^Follow up date cannot be prior to start date" Q
  1.  S APCDFDA(9000093,APCDIENS,.1)=Y
  1. E1000 ;
  1.  ;now check goal type
  1.  S C=0,APCDC=0 F  S C=$O(GDAT(1000,C)) Q:C'=+C  D
  1.  .S Z=GDAT(1000,C)
  1.  .I Z?1.N,'$D(^APCDTPGT(Z)) D E("invalid patient goal type") Q
  1.  .I Z'?1.N S X=Z,DIC="^APCDTPGT(",DIC(0)="" D ^DIC D  Q:Y=-1
  1.  ..I Y=-1 D E("invalid patient goal type") Q
  1.  ;if RETVAL then quit with the error
  1.  I RETVAL]"" Q
  1. E1101 ;
  1.  S X=$G(GDAT("1101",1))
  1.  D VAL^DIE(9000093,APCDIENS,1101,"EF",X,.APCDI,"APCDFDA","APCDE")
  1.  I $D(APCDE("DIERR",1,"TEXT",1)) D E(APCDE("DIERR",1,"TEXT",1)) Q
  1. E1201 ;
  1.  S X=$G(GDAT("1201",1))
  1.  D VAL^DIE(9000093,APCDIENS,1201,"EF",X,.APCDI,"APCDFDA","APCDE")
  1.  I $D(APCDE("DIERR",1,"TEXT",1)) D E(APCDE("DIERR",1,"TEXT",1)) Q
  1. E03 ;set other data values into the FDA array
  1.  S APCDFDA(9000093,APCDIENS,.02)=APCDPT
  1.  S APCDFDA(9000093,APCDIENS,.03)=DT
  1.  S APCDFDA(9000093,APCDIENS,.04)=DUZ
  1.  S APCDFDA(9000093,APCDIENS,.05)=$$NOW^XLFDT
  1.  S APCDFDA(9000093,APCDIENS,.11)="A"
  1.  S APCDFDA(9000093,APCDIENS,.12)=DUZ
  1. ADD1 D UPDATE^DIE("","APCDFDA","APCDIENS","APCDERR(1)")
  1.  I $D(APCDERR(1)) S RETVAL="0^error adding entry to Patient Goals file "_APCDERR(1) Q
  1.  S APCDGIEN=+$G(APCDIENS(1))
  1.  K APCDFDA
  1.  ;set in multiple goal type
  1.  S APCDI="",APCDC=0
  1.  F  S APCDC=$O(GDAT(1000,APCDC)) Q:APCDC'=+APCDC  D
  1.  .S DIE="^AUPNGOAL(",DA=APCDGIEN,DR="1000////"_GDAT(1000,APCDC) D ^DIE K DIE,DA,DR
  1.  .I $D(Y) S RETVAL="0^error adding goal type" S DA=APCDGIEN,DIK="^AUPNGOAL(" D ^DIK Q
  1.  I RETVAL]"" Q
  1.  S RETVAL=APCDGIEN
  1.  Q
  1.  ;
  1. DELGOAL(APCDGIEN,APCDGPRV,APCDGDTD,APCDGREA,APCDGOTH,RETVAL) ;PEP - called to delete a goal
  1.  ;marks the goal status as "deleted", does not physically delete the goal
  1.  ;INPUT - goal ien
  1.  ;APCDGREA - REASON FOR DELETION, SET OF CODES, FIELD 2.03 -
  1.  ;APCDGPRV - PROVIDER DELETING GOAL, IF NOT PASSED USES DUZ FIELD 2.01 PASS IEN PLEASE
  1.  ;APCDGOTH - COMMENT IF OTHER IS REASON FIELD 2.04
  1.  ;APCDGDTD - DATE/TIME DELETED 2.02 - USES $$NOW^XLFDT IF NOTHING PASSED, PASS INTERNAL VALUE PLEASE
  1.  ;OUTPUT - return value is 1 if delete successful or 0^error message if not successful
  1.  I '$G(APCDGIEN) S RETVAL="0^invalid ien" Q
  1.  I '$D(^AUPNGOAL(APCDGIEN)) S RETVAL="0^invalid ien, not entry" Q
  1.  S APCDGPRV=$G(APCDGPRV) I 'APCDGPRV S APCDGPRV=DUZ
  1.  S APCDGDTD=$G(APCDGDTD) I 'APCDGDTD S APCDGDTD=$$NOW^XLFDT()
  1.  S APCDGREA=$G(APCDGREA)
  1.  S APCDGOTH=$G(APCDGOTH)
  1.  NEW DIE,DA,DR,X,Y,DIC
  1.  S DA=APCDGIEN,DR=".11///D;2.01////"_APCDGPRV_";2.02////"_APCDGDTD_";2.03///"_APCDGREA_";2.04///"_APCDGOTH,DIE="^AUPNGOAL(" D ^DIE K DIE,DA,DR
  1.  I $D(Y) S RETVAL="0^error updating status field, goal not deleted" Q
  1.  S RETVAL=1
  1.  Q
  1. EDITGOAL(APCDGIEN,APCDFUD,APCDSTAT,APCDREVD,APCDREVT,RETVAL) ;PEP- edit a goal entry
  1.  ;only the following fields can be edited per requirements:  F/U DATE (.09), STATUS (.11)
  1.  ;you can also add a review date and review/follow up text, to edit a review comment use EDITREV API
  1.  ;INPUT : ien of goal, new followup date, new status, review date (optional), review comment (optional)
  1.  ;        if adding a review both review date and comment are required, if both are not passed they
  1.  ;        are ignored
  1.  ;OUTPUT :  1 if edit successful, 0^error message if not successful
  1.  ;
  1.  I '$G(APCDGIEN) S RETVAL="0^invalid ien" Q
  1.  I '$D(^AUPNGOAL(APCDGIEN)) S RETVAL="0^invalid ien, not entry" Q
  1.  S APCDFUD=$G(APCDFUD)
  1.  S APCDSTAT=$G(APCDSTAT)
  1.  S APCDREVD=$G(APCDREVD)
  1.  S APCDREVT=$G(APCDREVT)
  1.  ;edit incoming values
  1.  NEW DIE,DA,DR,X,Y,%DT,APCDFU,APCDI,APCDRD,APCDIENS,APCDFDA,APCDERR,DIC
  1.  S X=$G(APCDFUD)
  1.  I X="" G E1
  1.  S %DT=""
  1.  D ^%DT
  1.  I Y=-1 S RETVAL="0^Goal followup date invalid" Q
  1.  S APCDFU=Y
  1.  S X=$P(^AUPNGOAL(APCDGIEN,0),U,9) I X>APCDFU S RETVAL="0^goal followup date cannot be less than start date" Q
  1. E1 ;
  1.  S X=$G(APCDSTAT),APCDI=""
  1.  D CHK^DIE(9000093,.11,"",X,.APCDI)
  1.  I APCDI="^" S RETVAL="0^invalid status value" Q
  1.  ;if adding a review/fu edit those field values
  1.  I APCDREVD=""!(APCDREVT="") G ED
  1.  S X=$G(APCDREVD)
  1.  S %DT=""
  1.  D ^%DT
  1.  I Y=-1 S RETVAL="0^review date invalid" Q
  1.  S APCDRD=Y
  1.  S Y=""
  1.  D CHK^DIE(9000093.13,.02,"",APCDREVT,.Y)
  1.  I Y="^" S RETVAL="0^invalid review note" Q
  1. ED ;
  1.  S DA=APCDGIEN,DR=".1////"_APCDFU_";.11///"_APCDI_";.05////"_$$NOW^XLFDT()_";.12////"_DUZ,DIE="^AUPNGOAL(" D ^DIE K DIE,DA,DR
  1.  I $D(Y) S RETVAL="0^error updating status field, goal not deleted" Q
  1.  I APCDREVT]"",APCDREVD]"" D
  1.  .;add review to multiple
  1.  .S APCDIENS=""
  1.  .S APCDFDA(9000093.13,"+2,"_APCDGIEN_",",.01)=APCDRD
  1.  .S APCDFDA(9000093.13,"+2,"_APCDGIEN_",",.02)=APCDREVT
  1.  .D UPDATE^DIE("","APCDFDA","APCDIENS","APCDERR(1)")
  1.  .I $D(APCDERR(1)) S RETVAL=APCDERR("DIERR",1,"TEXT",1)
  1.  I RETVAL]"" Q
  1.  S RETVAL=1
  1.  Q
  1.  ;
  1. NEXTGN(P,F) ;PEP - return next available goal number for patient P, facility F
  1.  I $G(P)="" Q ""
  1.  I $G(F)="" Q ""
  1.  I '$D(^AUPNPAT(P)) Q ""
  1.  I '$D(^AUTTLOC(F)) Q ""
  1.  Q $E($O(^AUPNGOAL("AA",P,F,""),-1),2,999)\1+1
  1.  ;
  1. E(V) ;
  1.  S APCDEC=$G(APCDEC)+1,$P(RETVAL,"|",APCDEC)=V
  1.  Q