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

DGOTHUT1.m

Go to the documentation of this file.
  1. DGOTHUT1 ;SHRPE/YMG - OTHD (OTHER THAN HONORABLE DISCHARGE) APIs ;03/12/19
  1. ;;5.3;Registration;**952**;Aug 13, 1993;Build 160
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. ; 2053 Sup ^DIE:FILE, UPDATE
  1. ; 2171 Sup $$STA^XUAF4
  1. ; 10015 Sup GETS^DIQ
  1. ; 10103 Sup ^XLFDT: $$FMTE, $$NOW
  1. ; 2486 Con. Sub. ^IVMPLOG : EVENT
  1. ;
  1. LASTPRD(DGIEN33) ; find last 365 and 90 day periods
  1. ;
  1. ; DGIEN33 - file 33 ien
  1. ;
  1. ; returns the following string delimited by "^" (if data can't be found, corresponding piece is set to 0):
  1. ; p1 = # of the last 365 day period
  1. ; p2 = ien (in sub-file 33.01) of the last 365 day period
  1. ; p3 = # of the last 90 day period
  1. ; p4 = ien (in sub-file 33.11) of the last 90 day period
  1. ;
  1. N IEN3301,IEN3311,LST365,LST90,RES
  1. S RES="0^0^0^0" I $G(DGIEN33)>0,$D(^DGOTH(33,DGIEN33))>0 D
  1. .S LST365=+$O(^DGOTH(33,DGIEN33,1,"B",""),-1),IEN3301=+$O(^DGOTH(33,DGIEN33,1,"B",LST365,""))
  1. .I IEN3301>0 D
  1. ..S $P(RES,U)=LST365,$P(RES,U,2)=IEN3301
  1. ..S LST90=+$O(^DGOTH(33,DGIEN33,1,IEN3301,1,"B",""),-1)
  1. ..S IEN3311=+$O(^DGOTH(33,DGIEN33,1,IEN3301,1,"B",LST90,""))
  1. ..S $P(RES,U,3)=LST90,$P(RES,U,4)=IEN3311
  1. ..Q
  1. .Q
  1. Q RES
  1. ;
  1. GET90DT(DGIEN33,DGIEN3301,DGIEN3311) ; return dates info for a given 90 day period
  1. ;
  1. ; DGIEN33 - file 33 ien
  1. ; DGIEN3301 - sub-file 33.01 ien
  1. ; DGIEN3311 - sub-file 33.11 ien
  1. ;
  1. ; returns the following string delimited by "^" (if data can't be found, corresponding piece is set to 0):
  1. ; p1 = start date (internal FM format)
  1. ; p2 = end date (internal FM format)
  1. ; p3 = days left in this period
  1. ;
  1. N DAYS,EDT,IENS,NUM90,SDT
  1. S (DAYS,EDT)=0
  1. S IENS=DGIEN3311_","_DGIEN3301_","_DGIEN33_","
  1. S NUM90=$$GET1^DIQ(33.11,IENS,.01,"I")
  1. S SDT=+$$GET1^DIQ(33.11,IENS,.02,"I")
  1. I SDT D
  1. .S EDT=$$FMADD^XLFDT(SDT,$S(NUM90=1:90,1:89)),DAYS=$$FMDIFF^XLFDT(EDT,DT,1)
  1. .S DAYS=$S(DAYS<0:0,DAYS>90:90,1:DAYS)
  1. .Q
  1. Q SDT_U_EDT_U_DAYS
  1. ;
  1. GET365DT(DGIEN33,DGIEN3301) ; return dates info for a given 365 day period
  1. ;
  1. ; DGIEN33 - file 33 ien
  1. ; DGIEN3301 - sub-file 33.01 ien
  1. ;
  1. ; returns the following string delimited by "^" (if data can't be found, corresponding piece is set to 0):
  1. ; p1 = start date (internal FM format)
  1. ; p2 = end date (internal FM format)
  1. ;
  1. N EDT,SDT
  1. S EDT=0
  1. S SDT=+$$GET1^DIQ(33.01,DGIEN3301_","_DGIEN33_",",.02,"I")
  1. I SDT S EDT=$$FMADD^XLFDT(SDT,365)
  1. Q SDT_U_EDT
  1. ;
  1. LOCK(DGIEN33) ; lock entry in file 33
  1. ;
  1. ; DGIEN33 - file 33 ien of the entry to lock
  1. ;
  1. ; returns 1 if lock was successful, 0 otherwise
  1. ;
  1. N RES
  1. S RES=0
  1. I +$G(DGIEN33) L +^DGOTH(33,DGIEN33):5 S RES=$T
  1. Q RES
  1. ;
  1. UNLOCK(DGIEN33) ; unlock entry in file 33
  1. ;
  1. ; DGIEN33 - file 33 ien of the entry to unlock
  1. ;
  1. I +$G(DGIEN33) L -^DGOTH(33,DGIEN33)
  1. Q
  1. ;
  1. FILSTAT(DGDFN,STATUS) ; file OTH status into file 33
  1. ; creates new entry in file 33 if necessary, then updates field 33/.02
  1. ;
  1. ; DGDFN - patient DFN
  1. ; STATUS - OTH status (0 = inactive, 1 = active)
  1. ;
  1. ; returns 1 on success, "0 ^ [error message]" on failure
  1. ;
  1. N DGERR,DGFDA,IEN33,IENARY,IENS
  1. ;
  1. I +$G(DGDFN)'>0 Q "0^Invalid DFN"
  1. I "^0^1^"'[(U_$G(STATUS)_U) Q "0^Invalid status code"
  1. S IEN33=+$O(^DGOTH(33,"B",DGDFN,"")) I IEN33'>0 D
  1. .; no existing entry, so create one
  1. .S IENS="+1,"
  1. .S DGFDA(33,IENS,.01)=DGDFN
  1. .D UPDATE^DIE(,"DGFDA","IENARY","DGERR")
  1. .S IEN33=+$G(IENARY(1))
  1. .K DGFDA,IENARY
  1. .Q
  1. ; file new status into field .02
  1. S IENS=IEN33_","
  1. S DGFDA(33,IENS,.02)=STATUS
  1. ; try to lock entry
  1. I '$$LOCK(IEN33) Q "0^Unable to lock entry in file 33 (ien = "_IEN33_")"
  1. D FILE^DIE(,"DGFDA","DGERR")
  1. ; unlock entry
  1. D UNLOCK(IEN33)
  1. I $D(DGERR) Q "0^"_$G(DGERR("DIERR",1,"TEXT",1))
  1. Q 1
  1. ;
  1. FILAUTH(DGDFN,DATASTR) ; file authorized 90 day period into file 33
  1. ;
  1. ; creates new entries in sub-files 33.01 and/or 33.11 if necessary, then files data passed in DATASTR
  1. ; will only file data into an existing top level entry in file 33
  1. ;
  1. ; DGDFN - patient DFN
  1. ; DATASTR - string delimited by "^", as follows:
  1. ; p1 = 365 days period # to be filed - required
  1. ; p2 = 90 days period # to be filed - required
  1. ; p3 = date request submitted
  1. ; p4 = authorized by (name)
  1. ; p5 = authorization received date
  1. ; p6 = start date of this 90 days period
  1. ; p7 = entered by (name)
  1. ; p8 = facility (file 4 ien)
  1. ; p9 = request creation date / time
  1. ; p10 = edit date / time
  1. ;
  1. ; returns 1 on success, "0 ^ [error message]" on failure
  1. ;
  1. N DGERR,DGFDA,EDITTS,IEN33,IEN365,IEN90,IENARY,IENS,NUM365,NUM90,RES
  1. ;
  1. I +$G(DGDFN)'>0 Q "0^Invalid DFN"
  1. ; get file 33 ien to file data into
  1. S IEN33=+$O(^DGOTH(33,"B",DGDFN,"")) I IEN33'>0 Q "0^Unable to find an entry in file 33 for this patient"
  1. ; try to lock entry
  1. I '$$LOCK(IEN33) Q "0^Unable to lock entry in file 33 (ien = "_IEN33_")"
  1. S RES=1
  1. ; get sub-file 33.01 ien, create new entry if necessary
  1. S NUM365=+$P(DATASTR,U) I NUM365'>0 S RES="0^Invalid 365 day period number" G FILAUTHX
  1. S IEN365=+$O(^DGOTH(33,IEN33,1,"B",NUM365,"")) I IEN365'>0 D
  1. .; no existing entry for this 365 day period - create a new one
  1. .S IENS="+1,"_IEN33_","
  1. .S DGFDA(33.01,IENS,.01)=NUM365
  1. .I $P(DATASTR,U,6)>0 S DGFDA(33.01,IENS,.02)=$P(DATASTR,U,6) ; make start date of new 365 day period the same as starting date of 90 day period we're filing
  1. .D UPDATE^DIE(,"DGFDA","IENARY","DGERR")
  1. .S IEN365=+$G(IENARY(1))
  1. .K DGFDA,IENARY
  1. .Q
  1. I $D(DGERR) S RES="0^"_$G(DGERR("DIERR",1,"TEXT",1)) G FILAUTHX
  1. ; get sub-file 33.11 ien, create new entry if necessary
  1. S NUM90=+$P(DATASTR,U,2) I NUM90'>0 S RES="0^Invalid 90 day period number" G FILAUTHX
  1. S IEN90=+$O(^DGOTH(33,IEN33,1,IEN365,1,"B",NUM90,"")) I IEN90'>0 D
  1. .; no existing entry for this 90 day period - create a new one
  1. .S IENS="+1,"_IEN365_","_IEN33_","
  1. .S DGFDA(33.11,IENS,.01)=NUM90
  1. .D UPDATE^DIE(,"DGFDA","IENARY","DGERR")
  1. .S IEN90=+$G(IENARY(1))
  1. .K DGFDA,IENARY
  1. .Q
  1. I $D(DGERR) S RES="0^"_$G(DGERR("DIERR",1,"TEXT",1)) G FILAUTHX
  1. S EDITTS=$P(DATASTR,U,10) I +EDITTS'>0 S EDITTS=$$NOW^XLFDT()
  1. ; file data
  1. S IENS=IEN90_","_IEN365_","_IEN33_","
  1. I +$P(DATASTR,U,6) S DGFDA(33.11,IENS,.02)=$P(DATASTR,U,6) ; start date
  1. I +$P(DATASTR,U,3) S DGFDA(33.11,IENS,.03)=$P(DATASTR,U,3) ; date request submitted
  1. I +$P(DATASTR,U,5) S DGFDA(33.11,IENS,.04)=$P(DATASTR,U,5) ; auth. received date
  1. S DGFDA(33.11,IENS,.05)=$E($P(DATASTR,U,7),1,60) ; entered by
  1. S DGFDA(33.11,IENS,.06)=EDITTS ; date entered
  1. I $P(DATASTR,U,4)'="" S DGFDA(33.11,IENS,.07)=$E($P(DATASTR,U,4),1,60) ; authorized by
  1. S DGFDA(33.11,IENS,.08)=$P(DATASTR,U,8) ; facility
  1. I +$P(DATASTR,U,9)>0 S DGFDA(33.11,IENS,.09)=$P(DATASTR,U,9) ; creation date
  1. D FILE^DIE(,"DGFDA","DGERR")
  1. I $D(DGERR) S RES="0^"_$G(DGERR("DIERR",1,"TEXT",1))
  1. ;
  1. FILAUTHX ; exit point
  1. ; unlock entry
  1. D UNLOCK(IEN33)
  1. Q RES
  1. ;
  1. FILDEN(DGDFN,DATASTR) ; file denied authorization request into file 33
  1. ;
  1. ; creates new entry in sub-file 33.03, then files data passed in DATASTR
  1. ; will only file data into an existing top level entry in file 33
  1. ;
  1. ; DGDFN - patient DFN
  1. ; DATASTR - string delimited by "^", as follows:
  1. ; p1 = date request submitted
  1. ; p2 = authorization comment (rejection reason)
  1. ; p3 = entered by (name)
  1. ; p4 = facility (file 4 ien)
  1. ; p5 = request creation date / time
  1. ; p6 = edit date / time
  1. ;
  1. ; returns 1 on success, "0 ^ [error message]" on failure
  1. ;
  1. N DGERR,DGFDA,EDITTS,IEN33,IENS
  1. ;
  1. I +$G(DGDFN)'>0 Q "0^Invalid DFN"
  1. ; get file 33 ien to file data into
  1. S IEN33=+$O(^DGOTH(33,"B",DGDFN,"")) I IEN33'>0 Q "0^Unable to find an entry in file 33 for this patient"
  1. ; try to lock entry
  1. I '$$LOCK(IEN33) Q "0^Unable to lock entry in file 33 (ien = "_IEN33_")"
  1. S RES=1,IENS="+1,"_IEN33_","
  1. S EDITTS=$P(DATASTR,U,6) I +EDITTS'>0 S EDITTS=$$NOW^XLFDT()
  1. ; get the next available sequence number
  1. S DGFDA(33.03,IENS,.01)=$O(^DGOTH(33,IEN33,3,"B",""),-1)+1
  1. ;
  1. I +$P(DATASTR,U) S DGFDA(33.03,IENS,.02)=$P(DATASTR,U) ; date request submitted
  1. I $P(DATASTR,U,2)'="" S DGFDA(33.03,IENS,.03)=$E($P(DATASTR,U,2),1,60) ; auth. comment
  1. S DGFDA(33.03,IENS,.04)=$E($P(DATASTR,U,3),1,60) ; entered by
  1. S DGFDA(33.03,IENS,.05)=EDITTS ; date /time entered
  1. S DGFDA(33.03,IENS,.06)=$P(DATASTR,U,4) ; facility
  1. I +$P(DATASTR,U,5) S DGFDA(33.03,IENS,.07)=$P(DATASTR,U,5) ; creation date / time
  1. D UPDATE^DIE(,"DGFDA",,"DGERR")
  1. D UNLOCK(IEN33)
  1. I $D(DGERR) Q "0^"_$G(DGERR("DIERR",1,"TEXT",1))
  1. Q 1
  1. ;
  1. FILPEND(DGDFN,DATASTR) ; file pending authorization request into file 33
  1. ;
  1. ; files data passed in DATASTR into file 33 (top level)
  1. ; will only file data into an existing top level entry in file 33
  1. ;
  1. ; DGDFN - patient DFN
  1. ; DATASTR - string delimited by "^", as follows:
  1. ; p1 = pending request?(0 = no, 1 = yes)
  1. ; p2 = date request submitted
  1. ; p3 = entered by (name)
  1. ; p4 = facility (file 4 ien)
  1. ; p5 = creation date /time
  1. ; p6 = edit date / time
  1. ; *** setting DATASTR to "0^^^^^^" would delete existing pending request ***
  1. ;
  1. ; returns 1 on success, "0 ^ [error message]" on failure
  1. ;
  1. N DGERR,DGFDA,EDITTS,IEN33,IENS,PND
  1. ;
  1. I +$G(DGDFN)'>0 Q "0^Invalid DFN"
  1. ; get file 33 ien to file data into
  1. S IEN33=+$O(^DGOTH(33,"B",DGDFN,"")) I IEN33'>0 Q "0^Unable to find an entry in file 33 for this patient"
  1. ; try to lock entry
  1. I '$$LOCK(IEN33) Q "0^Unable to lock entry in file 33 (ien = "_IEN33_")"
  1. S IENS=IEN33_","
  1. S PND=+$P(DATASTR,U) ; pending request?
  1. S EDITTS=$P(DATASTR,U,6) I PND,+EDITTS'>0 S EDITTS=$$NOW^XLFDT()
  1. S DGFDA(33,IENS,.07)=PND
  1. S DGFDA(33,IENS,.03)=$P(DATASTR,U,2) ; pending request date
  1. S DGFDA(33,IENS,.04)=$E($P(DATASTR,U,3),1,60) ; pending req. entered by
  1. S DGFDA(33,IENS,.05)=EDITTS ; pending req. date entered /edited
  1. S DGFDA(33,IENS,.06)=$P(DATASTR,U,4) ; pending req. facility
  1. S DGFDA(33,IENS,.08)=$P(DATASTR,U,5) ; creation date / time
  1. D FILE^DIE(,"DGFDA","DGERR")
  1. D UNLOCK(IEN33)
  1. I $D(DGERR) Q "0^"_$G(DGERR("DIERR",1,"TEXT",1))
  1. Q 1
  1. ;
  1. GETPEND(DGDFN) ; get pending authorization request data from file 33
  1. ;
  1. ; DGDFN - patient DFN
  1. ;
  1. ; if there's no pending request, returns 0
  1. ; if error was encountered, returns "-1 ^ error message"
  1. ; if there is a pending request, returns the following string:
  1. ; "1 ^ pending request date ^ entered by (name) ^ date entered / edited ^ facility (station #) ^ creation date / time"
  1. ;
  1. N DGERR,DGFDA,IEN33,IENS,RES
  1. ;
  1. I +$G(DGDFN)'>0 Q "-1^Invalid DFN"
  1. ; get file 33 ien to get data from
  1. S IEN33=+$O(^DGOTH(33,"B",DGDFN,"")) I IEN33'>0 Q "-1^Unable to find an entry in file 33 for this patient"
  1. S IENS=IEN33_","
  1. D GETS^DIQ(33,IENS,".03:.08","I","DGFDA","DGERR")
  1. I $D(DGERR) Q "-1^"_$G(DGERR("DIERR",1,"TEXT",1))
  1. S RES=+DGFDA(33,IENS,.07,"I") I 'RES Q RES
  1. S $P(RES,U,2)=+DGFDA(33,IENS,.03,"I")
  1. S $P(RES,U,3)=DGFDA(33,IENS,.04,"I")
  1. S $P(RES,U,4)=+DGFDA(33,IENS,.05,"I")
  1. S $P(RES,U,5)=$$STA^XUAF4(+DGFDA(33,IENS,.06,"I"))
  1. S $P(RES,U,6)=+DGFDA(33,IENS,.08,"I")
  1. Q RES
  1. ;
  1. GETAUTH(DGIEN33,DGIEN365,DGIEN90) ; get authorized 90 day period data from file 33
  1. ;
  1. ; DGIEN33 - ien in file 33
  1. ; DGIEN365 - ien in sub-file 33.01
  1. ; DGIEN90 - ien in sub-file 33.11
  1. ;
  1. ; if error was encountered, returns "-1 ^ error message"
  1. ; otherwise returns the following "^"-delimited string:
  1. ; p1 - 365 day period number
  1. ; p2 - 90 day period number
  1. ; p3 - start date (internal FM)
  1. ; p4 - date request submitted (internal FM)
  1. ; p5 - authorization received date (internal FM)
  1. ; p6 - entered / edited by (name)
  1. ; p7 - date entered / edited (internal FM)
  1. ; p8 - authorized by (name)
  1. ; p9 - facility (station #)
  1. ; p10 - creation date /time (internal FM)
  1. ;
  1. N DGERR,DGFDA,IENS,NUM365,RES,Z
  1. ;
  1. I +$G(DGIEN33)'>0 Q "-1^Invalid file 33 ien"
  1. I +$G(DGIEN365)'>0 Q "-1^Invalid sub-file 33.01 ien"
  1. I +$G(DGIEN90)'>0 Q "-1^Invalid sub-file 33.11 ien"
  1. S IENS=DGIEN365_","_DGIEN33_","
  1. S NUM365=$$GET1^DIQ(33.01,IENS,.01,"I",,"DGERR")
  1. I $D(DGERR) Q "-1^"_$G(DGERR("DIERR",1,"TEXT",1))
  1. S IENS=DGIEN90_","_IENS
  1. D GETS^DIQ(33.11,IENS,"*","I","DGFDA","DGERR")
  1. I $D(DGERR) Q "-1^"_$G(DGERR("DIERR",1,"TEXT",1))
  1. F Z=1:1:9 D
  1. .I Z=8 S $P(RES,U,Z)=$$STA^XUAF4($G(DGFDA(33.11,IENS,Z/100,"I"))) Q
  1. .S $P(RES,U,Z)=$G(DGFDA(33.11,IENS,Z/100,"I"))
  1. S RES=NUM365_U_RES
  1. Q RES
  1. ;
  1. GETDEN(DGIEN33,DENIEN) ; get denied authorization request data from file 33
  1. ;
  1. ; DGIEN33 - ien in file 33
  1. ; DENIEN - ien in sub-file 33.03
  1. ;
  1. ; if error was encountered, returns "-1 ^ error message"
  1. ; otherwise returns the following "^"-delimited string:
  1. ; p1 - sequence number
  1. ; p2 - date request submitted (internal FM)
  1. ; p3 - authorization comment
  1. ; p4 - entered by (name)
  1. ; p5 - date entered (internal FM)
  1. ; p6 - facility (station #)
  1. ; p7 - creation date / time
  1. ;
  1. N DGERR,DGFDA,IENS,RES,Z
  1. ;
  1. I +$G(DGIEN33)'>0 Q "-1^Invalid file 33 ien"
  1. I +$G(DENIEN)'>0 Q "-1^Invalid sub-file 33.03 ien"
  1. S IENS=DENIEN_","_DGIEN33_","
  1. D GETS^DIQ(33.03,IENS,"*","I","DGFDA","DGERR")
  1. I $D(DGERR) Q "-1^"_$G(DGERR("DIERR",1,"TEXT",1))
  1. F Z=1:1:7 D
  1. . I Z=6 S $P(RES,U,Z)=$$STA^XUAF4($G(DGFDA(33.03,IENS,Z/100,"I"))) Q
  1. . S $P(RES,U,Z)=$G(DGFDA(33.03,IENS,Z/100,"I"))
  1. Q RES