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