DGOTHUT1 ;SHRPE/YMG - OTHD (OTHER THAN HONORABLE DISCHARGE) APIs ;03/12/19
;;5.3;Registration;**952**;Aug 13, 1993;Build 160
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
; 2053 Sup ^DIE:FILE, UPDATE
; 2171 Sup $$STA^XUAF4
; 10015 Sup GETS^DIQ
; 10103 Sup ^XLFDT: $$FMTE, $$NOW
; 2486 Con. Sub. ^IVMPLOG : EVENT
;
LASTPRD(DGIEN33) ; find last 365 and 90 day periods
;
; DGIEN33 - file 33 ien
;
; returns the following string delimited by "^" (if data can't be found, corresponding piece is set to 0):
; p1 = # of the last 365 day period
; p2 = ien (in sub-file 33.01) of the last 365 day period
; p3 = # of the last 90 day period
; p4 = ien (in sub-file 33.11) of the last 90 day period
;
N IEN3301,IEN3311,LST365,LST90,RES
S RES="0^0^0^0" I $G(DGIEN33)>0,$D(^DGOTH(33,DGIEN33))>0 D
.S LST365=+$O(^DGOTH(33,DGIEN33,1,"B",""),-1),IEN3301=+$O(^DGOTH(33,DGIEN33,1,"B",LST365,""))
.I IEN3301>0 D
..S $P(RES,U)=LST365,$P(RES,U,2)=IEN3301
..S LST90=+$O(^DGOTH(33,DGIEN33,1,IEN3301,1,"B",""),-1)
..S IEN3311=+$O(^DGOTH(33,DGIEN33,1,IEN3301,1,"B",LST90,""))
..S $P(RES,U,3)=LST90,$P(RES,U,4)=IEN3311
..Q
.Q
Q RES
;
GET90DT(DGIEN33,DGIEN3301,DGIEN3311) ; return dates info for a given 90 day period
;
; DGIEN33 - file 33 ien
; DGIEN3301 - sub-file 33.01 ien
; DGIEN3311 - sub-file 33.11 ien
;
; returns the following string delimited by "^" (if data can't be found, corresponding piece is set to 0):
; p1 = start date (internal FM format)
; p2 = end date (internal FM format)
; p3 = days left in this period
;
N DAYS,EDT,IENS,NUM90,SDT
S (DAYS,EDT)=0
S IENS=DGIEN3311_","_DGIEN3301_","_DGIEN33_","
S NUM90=$$GET1^DIQ(33.11,IENS,.01,"I")
S SDT=+$$GET1^DIQ(33.11,IENS,.02,"I")
I SDT D
.S EDT=$$FMADD^XLFDT(SDT,$S(NUM90=1:90,1:89)),DAYS=$$FMDIFF^XLFDT(EDT,DT,1)
.S DAYS=$S(DAYS<0:0,DAYS>90:90,1:DAYS)
.Q
Q SDT_U_EDT_U_DAYS
;
GET365DT(DGIEN33,DGIEN3301) ; return dates info for a given 365 day period
;
; DGIEN33 - file 33 ien
; DGIEN3301 - sub-file 33.01 ien
;
; returns the following string delimited by "^" (if data can't be found, corresponding piece is set to 0):
; p1 = start date (internal FM format)
; p2 = end date (internal FM format)
;
N EDT,SDT
S EDT=0
S SDT=+$$GET1^DIQ(33.01,DGIEN3301_","_DGIEN33_",",.02,"I")
I SDT S EDT=$$FMADD^XLFDT(SDT,365)
Q SDT_U_EDT
;
LOCK(DGIEN33) ; lock entry in file 33
;
; DGIEN33 - file 33 ien of the entry to lock
;
; returns 1 if lock was successful, 0 otherwise
;
N RES
S RES=0
I +$G(DGIEN33) L +^DGOTH(33,DGIEN33):5 S RES=$T
Q RES
;
UNLOCK(DGIEN33) ; unlock entry in file 33
;
; DGIEN33 - file 33 ien of the entry to unlock
;
I +$G(DGIEN33) L -^DGOTH(33,DGIEN33)
Q
;
FILSTAT(DGDFN,STATUS) ; file OTH status into file 33
; creates new entry in file 33 if necessary, then updates field 33/.02
;
; DGDFN - patient DFN
; STATUS - OTH status (0 = inactive, 1 = active)
;
; returns 1 on success, "0 ^ [error message]" on failure
;
N DGERR,DGFDA,IEN33,IENARY,IENS
;
I +$G(DGDFN)'>0 Q "0^Invalid DFN"
I "^0^1^"'[(U_$G(STATUS)_U) Q "0^Invalid status code"
S IEN33=+$O(^DGOTH(33,"B",DGDFN,"")) I IEN33'>0 D
.; no existing entry, so create one
.S IENS="+1,"
.S DGFDA(33,IENS,.01)=DGDFN
.D UPDATE^DIE(,"DGFDA","IENARY","DGERR")
.S IEN33=+$G(IENARY(1))
.K DGFDA,IENARY
.Q
; file new status into field .02
S IENS=IEN33_","
S DGFDA(33,IENS,.02)=STATUS
; try to lock entry
I '$$LOCK(IEN33) Q "0^Unable to lock entry in file 33 (ien = "_IEN33_")"
D FILE^DIE(,"DGFDA","DGERR")
; unlock entry
D UNLOCK(IEN33)
I $D(DGERR) Q "0^"_$G(DGERR("DIERR",1,"TEXT",1))
Q 1
;
FILAUTH(DGDFN,DATASTR) ; file authorized 90 day period into file 33
;
; creates new entries in sub-files 33.01 and/or 33.11 if necessary, then files data passed in DATASTR
; will only file data into an existing top level entry in file 33
;
; DGDFN - patient DFN
; DATASTR - string delimited by "^", as follows:
; p1 = 365 days period # to be filed - required
; p2 = 90 days period # to be filed - required
; p3 = date request submitted
; p4 = authorized by (name)
; p5 = authorization received date
; p6 = start date of this 90 days period
; p7 = entered by (name)
; p8 = facility (file 4 ien)
; p9 = request creation date / time
; p10 = edit date / time
;
; returns 1 on success, "0 ^ [error message]" on failure
;
N DGERR,DGFDA,EDITTS,IEN33,IEN365,IEN90,IENARY,IENS,NUM365,NUM90,RES
;
I +$G(DGDFN)'>0 Q "0^Invalid DFN"
; get file 33 ien to file data into
S IEN33=+$O(^DGOTH(33,"B",DGDFN,"")) I IEN33'>0 Q "0^Unable to find an entry in file 33 for this patient"
; try to lock entry
I '$$LOCK(IEN33) Q "0^Unable to lock entry in file 33 (ien = "_IEN33_")"
S RES=1
; get sub-file 33.01 ien, create new entry if necessary
S NUM365=+$P(DATASTR,U) I NUM365'>0 S RES="0^Invalid 365 day period number" G FILAUTHX
S IEN365=+$O(^DGOTH(33,IEN33,1,"B",NUM365,"")) I IEN365'>0 D
.; no existing entry for this 365 day period - create a new one
.S IENS="+1,"_IEN33_","
.S DGFDA(33.01,IENS,.01)=NUM365
.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
.D UPDATE^DIE(,"DGFDA","IENARY","DGERR")
.S IEN365=+$G(IENARY(1))
.K DGFDA,IENARY
.Q
I $D(DGERR) S RES="0^"_$G(DGERR("DIERR",1,"TEXT",1)) G FILAUTHX
; get sub-file 33.11 ien, create new entry if necessary
S NUM90=+$P(DATASTR,U,2) I NUM90'>0 S RES="0^Invalid 90 day period number" G FILAUTHX
S IEN90=+$O(^DGOTH(33,IEN33,1,IEN365,1,"B",NUM90,"")) I IEN90'>0 D
.; no existing entry for this 90 day period - create a new one
.S IENS="+1,"_IEN365_","_IEN33_","
.S DGFDA(33.11,IENS,.01)=NUM90
.D UPDATE^DIE(,"DGFDA","IENARY","DGERR")
.S IEN90=+$G(IENARY(1))
.K DGFDA,IENARY
.Q
I $D(DGERR) S RES="0^"_$G(DGERR("DIERR",1,"TEXT",1)) G FILAUTHX
S EDITTS=$P(DATASTR,U,10) I +EDITTS'>0 S EDITTS=$$NOW^XLFDT()
; file data
S IENS=IEN90_","_IEN365_","_IEN33_","
I +$P(DATASTR,U,6) S DGFDA(33.11,IENS,.02)=$P(DATASTR,U,6) ; start date
I +$P(DATASTR,U,3) S DGFDA(33.11,IENS,.03)=$P(DATASTR,U,3) ; date request submitted
I +$P(DATASTR,U,5) S DGFDA(33.11,IENS,.04)=$P(DATASTR,U,5) ; auth. received date
S DGFDA(33.11,IENS,.05)=$E($P(DATASTR,U,7),1,60) ; entered by
S DGFDA(33.11,IENS,.06)=EDITTS ; date entered
I $P(DATASTR,U,4)'="" S DGFDA(33.11,IENS,.07)=$E($P(DATASTR,U,4),1,60) ; authorized by
S DGFDA(33.11,IENS,.08)=$P(DATASTR,U,8) ; facility
I +$P(DATASTR,U,9)>0 S DGFDA(33.11,IENS,.09)=$P(DATASTR,U,9) ; creation date
D FILE^DIE(,"DGFDA","DGERR")
I $D(DGERR) S RES="0^"_$G(DGERR("DIERR",1,"TEXT",1))
;
FILAUTHX ; exit point
; unlock entry
D UNLOCK(IEN33)
Q RES
;
FILDEN(DGDFN,DATASTR) ; file denied authorization request into file 33
;
; creates new entry in sub-file 33.03, then files data passed in DATASTR
; will only file data into an existing top level entry in file 33
;
; DGDFN - patient DFN
; DATASTR - string delimited by "^", as follows:
; p1 = date request submitted
; p2 = authorization comment (rejection reason)
; p3 = entered by (name)
; p4 = facility (file 4 ien)
; p5 = request creation date / time
; p6 = edit date / time
;
; returns 1 on success, "0 ^ [error message]" on failure
;
N DGERR,DGFDA,EDITTS,IEN33,IENS
;
I +$G(DGDFN)'>0 Q "0^Invalid DFN"
; get file 33 ien to file data into
S IEN33=+$O(^DGOTH(33,"B",DGDFN,"")) I IEN33'>0 Q "0^Unable to find an entry in file 33 for this patient"
; try to lock entry
I '$$LOCK(IEN33) Q "0^Unable to lock entry in file 33 (ien = "_IEN33_")"
S RES=1,IENS="+1,"_IEN33_","
S EDITTS=$P(DATASTR,U,6) I +EDITTS'>0 S EDITTS=$$NOW^XLFDT()
; get the next available sequence number
S DGFDA(33.03,IENS,.01)=$O(^DGOTH(33,IEN33,3,"B",""),-1)+1
;
I +$P(DATASTR,U) S DGFDA(33.03,IENS,.02)=$P(DATASTR,U) ; date request submitted
I $P(DATASTR,U,2)'="" S DGFDA(33.03,IENS,.03)=$E($P(DATASTR,U,2),1,60) ; auth. comment
S DGFDA(33.03,IENS,.04)=$E($P(DATASTR,U,3),1,60) ; entered by
S DGFDA(33.03,IENS,.05)=EDITTS ; date /time entered
S DGFDA(33.03,IENS,.06)=$P(DATASTR,U,4) ; facility
I +$P(DATASTR,U,5) S DGFDA(33.03,IENS,.07)=$P(DATASTR,U,5) ; creation date / time
D UPDATE^DIE(,"DGFDA",,"DGERR")
D UNLOCK(IEN33)
I $D(DGERR) Q "0^"_$G(DGERR("DIERR",1,"TEXT",1))
Q 1
;
FILPEND(DGDFN,DATASTR) ; file pending authorization request into file 33
;
; files data passed in DATASTR into file 33 (top level)
; will only file data into an existing top level entry in file 33
;
; DGDFN - patient DFN
; DATASTR - string delimited by "^", as follows:
; p1 = pending request?(0 = no, 1 = yes)
; p2 = date request submitted
; p3 = entered by (name)
; p4 = facility (file 4 ien)
; p5 = creation date /time
; p6 = edit date / time
; *** setting DATASTR to "0^^^^^^" would delete existing pending request ***
;
; returns 1 on success, "0 ^ [error message]" on failure
;
N DGERR,DGFDA,EDITTS,IEN33,IENS,PND
;
I +$G(DGDFN)'>0 Q "0^Invalid DFN"
; get file 33 ien to file data into
S IEN33=+$O(^DGOTH(33,"B",DGDFN,"")) I IEN33'>0 Q "0^Unable to find an entry in file 33 for this patient"
; try to lock entry
I '$$LOCK(IEN33) Q "0^Unable to lock entry in file 33 (ien = "_IEN33_")"
S IENS=IEN33_","
S PND=+$P(DATASTR,U) ; pending request?
S EDITTS=$P(DATASTR,U,6) I PND,+EDITTS'>0 S EDITTS=$$NOW^XLFDT()
S DGFDA(33,IENS,.07)=PND
S DGFDA(33,IENS,.03)=$P(DATASTR,U,2) ; pending request date
S DGFDA(33,IENS,.04)=$E($P(DATASTR,U,3),1,60) ; pending req. entered by
S DGFDA(33,IENS,.05)=EDITTS ; pending req. date entered /edited
S DGFDA(33,IENS,.06)=$P(DATASTR,U,4) ; pending req. facility
S DGFDA(33,IENS,.08)=$P(DATASTR,U,5) ; creation date / time
D FILE^DIE(,"DGFDA","DGERR")
D UNLOCK(IEN33)
I $D(DGERR) Q "0^"_$G(DGERR("DIERR",1,"TEXT",1))
Q 1
;
GETPEND(DGDFN) ; get pending authorization request data from file 33
;
; DGDFN - patient DFN
;
; if there's no pending request, returns 0
; if error was encountered, returns "-1 ^ error message"
; if there is a pending request, returns the following string:
; "1 ^ pending request date ^ entered by (name) ^ date entered / edited ^ facility (station #) ^ creation date / time"
;
N DGERR,DGFDA,IEN33,IENS,RES
;
I +$G(DGDFN)'>0 Q "-1^Invalid DFN"
; get file 33 ien to get data from
S IEN33=+$O(^DGOTH(33,"B",DGDFN,"")) I IEN33'>0 Q "-1^Unable to find an entry in file 33 for this patient"
S IENS=IEN33_","
D GETS^DIQ(33,IENS,".03:.08","I","DGFDA","DGERR")
I $D(DGERR) Q "-1^"_$G(DGERR("DIERR",1,"TEXT",1))
S RES=+DGFDA(33,IENS,.07,"I") I 'RES Q RES
S $P(RES,U,2)=+DGFDA(33,IENS,.03,"I")
S $P(RES,U,3)=DGFDA(33,IENS,.04,"I")
S $P(RES,U,4)=+DGFDA(33,IENS,.05,"I")
S $P(RES,U,5)=$$STA^XUAF4(+DGFDA(33,IENS,.06,"I"))
S $P(RES,U,6)=+DGFDA(33,IENS,.08,"I")
Q RES
;
GETAUTH(DGIEN33,DGIEN365,DGIEN90) ; get authorized 90 day period data from file 33
;
; DGIEN33 - ien in file 33
; DGIEN365 - ien in sub-file 33.01
; DGIEN90 - ien in sub-file 33.11
;
; if error was encountered, returns "-1 ^ error message"
; otherwise returns the following "^"-delimited string:
; p1 - 365 day period number
; p2 - 90 day period number
; p3 - start date (internal FM)
; p4 - date request submitted (internal FM)
; p5 - authorization received date (internal FM)
; p6 - entered / edited by (name)
; p7 - date entered / edited (internal FM)
; p8 - authorized by (name)
; p9 - facility (station #)
; p10 - creation date /time (internal FM)
;
N DGERR,DGFDA,IENS,NUM365,RES,Z
;
I +$G(DGIEN33)'>0 Q "-1^Invalid file 33 ien"
I +$G(DGIEN365)'>0 Q "-1^Invalid sub-file 33.01 ien"
I +$G(DGIEN90)'>0 Q "-1^Invalid sub-file 33.11 ien"
S IENS=DGIEN365_","_DGIEN33_","
S NUM365=$$GET1^DIQ(33.01,IENS,.01,"I",,"DGERR")
I $D(DGERR) Q "-1^"_$G(DGERR("DIERR",1,"TEXT",1))
S IENS=DGIEN90_","_IENS
D GETS^DIQ(33.11,IENS,"*","I","DGFDA","DGERR")
I $D(DGERR) Q "-1^"_$G(DGERR("DIERR",1,"TEXT",1))
F Z=1:1:9 D
.I Z=8 S $P(RES,U,Z)=$$STA^XUAF4($G(DGFDA(33.11,IENS,Z/100,"I"))) Q
.S $P(RES,U,Z)=$G(DGFDA(33.11,IENS,Z/100,"I"))
S RES=NUM365_U_RES
Q RES
;
GETDEN(DGIEN33,DENIEN) ; get denied authorization request data from file 33
;
; DGIEN33 - ien in file 33
; DENIEN - ien in sub-file 33.03
;
; if error was encountered, returns "-1 ^ error message"
; otherwise returns the following "^"-delimited string:
; p1 - sequence number
; p2 - date request submitted (internal FM)
; p3 - authorization comment
; p4 - entered by (name)
; p5 - date entered (internal FM)
; p6 - facility (station #)
; p7 - creation date / time
;
N DGERR,DGFDA,IENS,RES,Z
;
I +$G(DGIEN33)'>0 Q "-1^Invalid file 33 ien"
I +$G(DENIEN)'>0 Q "-1^Invalid sub-file 33.03 ien"
S IENS=DENIEN_","_DGIEN33_","
D GETS^DIQ(33.03,IENS,"*","I","DGFDA","DGERR")
I $D(DGERR) Q "-1^"_$G(DGERR("DIERR",1,"TEXT",1))
F Z=1:1:7 D
. I Z=6 S $P(RES,U,Z)=$$STA^XUAF4($G(DGFDA(33.03,IENS,Z/100,"I"))) Q
. S $P(RES,U,Z)=$G(DGFDA(33.03,IENS,Z/100,"I"))
Q RES
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGOTHUT1 13395 printed Oct 16, 2024@18:47:43 Page 2
DGOTHUT1 ;SHRPE/YMG - OTHD (OTHER THAN HONORABLE DISCHARGE) APIs ;03/12/19
+1 ;;5.3;Registration;**952**;Aug 13, 1993;Build 160
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ; 2053 Sup ^DIE:FILE, UPDATE
+7 ; 2171 Sup $$STA^XUAF4
+8 ; 10015 Sup GETS^DIQ
+9 ; 10103 Sup ^XLFDT: $$FMTE, $$NOW
+10 ; 2486 Con. Sub. ^IVMPLOG : EVENT
+11 ;
LASTPRD(DGIEN33) ; find last 365 and 90 day periods
+1 ;
+2 ; DGIEN33 - file 33 ien
+3 ;
+4 ; returns the following string delimited by "^" (if data can't be found, corresponding piece is set to 0):
+5 ; p1 = # of the last 365 day period
+6 ; p2 = ien (in sub-file 33.01) of the last 365 day period
+7 ; p3 = # of the last 90 day period
+8 ; p4 = ien (in sub-file 33.11) of the last 90 day period
+9 ;
+10 NEW IEN3301,IEN3311,LST365,LST90,RES
+11 SET RES="0^0^0^0"
IF $GET(DGIEN33)>0
IF $DATA(^DGOTH(33,DGIEN33))>0
Begin DoDot:1
+12 SET LST365=+$ORDER(^DGOTH(33,DGIEN33,1,"B",""),-1)
SET IEN3301=+$ORDER(^DGOTH(33,DGIEN33,1,"B",LST365,""))
+13 IF IEN3301>0
Begin DoDot:2
+14 SET $PIECE(RES,U)=LST365
SET $PIECE(RES,U,2)=IEN3301
+15 SET LST90=+$ORDER(^DGOTH(33,DGIEN33,1,IEN3301,1,"B",""),-1)
+16 SET IEN3311=+$ORDER(^DGOTH(33,DGIEN33,1,IEN3301,1,"B",LST90,""))
+17 SET $PIECE(RES,U,3)=LST90
SET $PIECE(RES,U,4)=IEN3311
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 QUIT RES
+21 ;
GET90DT(DGIEN33,DGIEN3301,DGIEN3311) ; return dates info for a given 90 day period
+1 ;
+2 ; DGIEN33 - file 33 ien
+3 ; DGIEN3301 - sub-file 33.01 ien
+4 ; DGIEN3311 - sub-file 33.11 ien
+5 ;
+6 ; returns the following string delimited by "^" (if data can't be found, corresponding piece is set to 0):
+7 ; p1 = start date (internal FM format)
+8 ; p2 = end date (internal FM format)
+9 ; p3 = days left in this period
+10 ;
+11 NEW DAYS,EDT,IENS,NUM90,SDT
+12 SET (DAYS,EDT)=0
+13 SET IENS=DGIEN3311_","_DGIEN3301_","_DGIEN33_","
+14 SET NUM90=$$GET1^DIQ(33.11,IENS,.01,"I")
+15 SET SDT=+$$GET1^DIQ(33.11,IENS,.02,"I")
+16 IF SDT
Begin DoDot:1
+17 SET EDT=$$FMADD^XLFDT(SDT,$SELECT(NUM90=1:90,1:89))
SET DAYS=$$FMDIFF^XLFDT(EDT,DT,1)
+18 SET DAYS=$SELECT(DAYS<0:0,DAYS>90:90,1:DAYS)
+19 QUIT
End DoDot:1
+20 QUIT SDT_U_EDT_U_DAYS
+21 ;
GET365DT(DGIEN33,DGIEN3301) ; return dates info for a given 365 day period
+1 ;
+2 ; DGIEN33 - file 33 ien
+3 ; DGIEN3301 - sub-file 33.01 ien
+4 ;
+5 ; returns the following string delimited by "^" (if data can't be found, corresponding piece is set to 0):
+6 ; p1 = start date (internal FM format)
+7 ; p2 = end date (internal FM format)
+8 ;
+9 NEW EDT,SDT
+10 SET EDT=0
+11 SET SDT=+$$GET1^DIQ(33.01,DGIEN3301_","_DGIEN33_",",.02,"I")
+12 IF SDT
SET EDT=$$FMADD^XLFDT(SDT,365)
+13 QUIT SDT_U_EDT
+14 ;
LOCK(DGIEN33) ; lock entry in file 33
+1 ;
+2 ; DGIEN33 - file 33 ien of the entry to lock
+3 ;
+4 ; returns 1 if lock was successful, 0 otherwise
+5 ;
+6 NEW RES
+7 SET RES=0
+8 IF +$GET(DGIEN33)
LOCK +^DGOTH(33,DGIEN33):5
SET RES=$TEST
+9 QUIT RES
+10 ;
UNLOCK(DGIEN33) ; unlock entry in file 33
+1 ;
+2 ; DGIEN33 - file 33 ien of the entry to unlock
+3 ;
+4 IF +$GET(DGIEN33)
LOCK -^DGOTH(33,DGIEN33)
+5 QUIT
+6 ;
FILSTAT(DGDFN,STATUS) ; file OTH status into file 33
+1 ; creates new entry in file 33 if necessary, then updates field 33/.02
+2 ;
+3 ; DGDFN - patient DFN
+4 ; STATUS - OTH status (0 = inactive, 1 = active)
+5 ;
+6 ; returns 1 on success, "0 ^ [error message]" on failure
+7 ;
+8 NEW DGERR,DGFDA,IEN33,IENARY,IENS
+9 ;
+10 IF +$GET(DGDFN)'>0
QUIT "0^Invalid DFN"
+11 IF "^0^1^"'[(U_$GET(STATUS)_U)
QUIT "0^Invalid status code"
+12 SET IEN33=+$ORDER(^DGOTH(33,"B",DGDFN,""))
IF IEN33'>0
Begin DoDot:1
+13 ; no existing entry, so create one
+14 SET IENS="+1,"
+15 SET DGFDA(33,IENS,.01)=DGDFN
+16 DO UPDATE^DIE(,"DGFDA","IENARY","DGERR")
+17 SET IEN33=+$GET(IENARY(1))
+18 KILL DGFDA,IENARY
+19 QUIT
End DoDot:1
+20 ; file new status into field .02
+21 SET IENS=IEN33_","
+22 SET DGFDA(33,IENS,.02)=STATUS
+23 ; try to lock entry
+24 IF '$$LOCK(IEN33)
QUIT "0^Unable to lock entry in file 33 (ien = "_IEN33_")"
+25 DO FILE^DIE(,"DGFDA","DGERR")
+26 ; unlock entry
+27 DO UNLOCK(IEN33)
+28 IF $DATA(DGERR)
QUIT "0^"_$GET(DGERR("DIERR",1,"TEXT",1))
+29 QUIT 1
+30 ;
FILAUTH(DGDFN,DATASTR) ; file authorized 90 day period into file 33
+1 ;
+2 ; creates new entries in sub-files 33.01 and/or 33.11 if necessary, then files data passed in DATASTR
+3 ; will only file data into an existing top level entry in file 33
+4 ;
+5 ; DGDFN - patient DFN
+6 ; DATASTR - string delimited by "^", as follows:
+7 ; p1 = 365 days period # to be filed - required
+8 ; p2 = 90 days period # to be filed - required
+9 ; p3 = date request submitted
+10 ; p4 = authorized by (name)
+11 ; p5 = authorization received date
+12 ; p6 = start date of this 90 days period
+13 ; p7 = entered by (name)
+14 ; p8 = facility (file 4 ien)
+15 ; p9 = request creation date / time
+16 ; p10 = edit date / time
+17 ;
+18 ; returns 1 on success, "0 ^ [error message]" on failure
+19 ;
+20 NEW DGERR,DGFDA,EDITTS,IEN33,IEN365,IEN90,IENARY,IENS,NUM365,NUM90,RES
+21 ;
+22 IF +$GET(DGDFN)'>0
QUIT "0^Invalid DFN"
+23 ; get file 33 ien to file data into
+24 SET IEN33=+$ORDER(^DGOTH(33,"B",DGDFN,""))
IF IEN33'>0
QUIT "0^Unable to find an entry in file 33 for this patient"
+25 ; try to lock entry
+26 IF '$$LOCK(IEN33)
QUIT "0^Unable to lock entry in file 33 (ien = "_IEN33_")"
+27 SET RES=1
+28 ; get sub-file 33.01 ien, create new entry if necessary
+29 SET NUM365=+$PIECE(DATASTR,U)
IF NUM365'>0
SET RES="0^Invalid 365 day period number"
GOTO FILAUTHX
+30 SET IEN365=+$ORDER(^DGOTH(33,IEN33,1,"B",NUM365,""))
IF IEN365'>0
Begin DoDot:1
+31 ; no existing entry for this 365 day period - create a new one
+32 SET IENS="+1,"_IEN33_","
+33 SET DGFDA(33.01,IENS,.01)=NUM365
+34 ; make start date of new 365 day period the same as starting date of 90 day period we're filing
IF $PIECE(DATASTR,U,6)>0
SET DGFDA(33.01,IENS,.02)=$PIECE(DATASTR,U,6)
+35 DO UPDATE^DIE(,"DGFDA","IENARY","DGERR")
+36 SET IEN365=+$GET(IENARY(1))
+37 KILL DGFDA,IENARY
+38 QUIT
End DoDot:1
+39 IF $DATA(DGERR)
SET RES="0^"_$GET(DGERR("DIERR",1,"TEXT",1))
GOTO FILAUTHX
+40 ; get sub-file 33.11 ien, create new entry if necessary
+41 SET NUM90=+$PIECE(DATASTR,U,2)
IF NUM90'>0
SET RES="0^Invalid 90 day period number"
GOTO FILAUTHX
+42 SET IEN90=+$ORDER(^DGOTH(33,IEN33,1,IEN365,1,"B",NUM90,""))
IF IEN90'>0
Begin DoDot:1
+43 ; no existing entry for this 90 day period - create a new one
+44 SET IENS="+1,"_IEN365_","_IEN33_","
+45 SET DGFDA(33.11,IENS,.01)=NUM90
+46 DO UPDATE^DIE(,"DGFDA","IENARY","DGERR")
+47 SET IEN90=+$GET(IENARY(1))
+48 KILL DGFDA,IENARY
+49 QUIT
End DoDot:1
+50 IF $DATA(DGERR)
SET RES="0^"_$GET(DGERR("DIERR",1,"TEXT",1))
GOTO FILAUTHX
+51 SET EDITTS=$PIECE(DATASTR,U,10)
IF +EDITTS'>0
SET EDITTS=$$NOW^XLFDT()
+52 ; file data
+53 SET IENS=IEN90_","_IEN365_","_IEN33_","
+54 ; start date
IF +$PIECE(DATASTR,U,6)
SET DGFDA(33.11,IENS,.02)=$PIECE(DATASTR,U,6)
+55 ; date request submitted
IF +$PIECE(DATASTR,U,3)
SET DGFDA(33.11,IENS,.03)=$PIECE(DATASTR,U,3)
+56 ; auth. received date
IF +$PIECE(DATASTR,U,5)
SET DGFDA(33.11,IENS,.04)=$PIECE(DATASTR,U,5)
+57 ; entered by
SET DGFDA(33.11,IENS,.05)=$EXTRACT($PIECE(DATASTR,U,7),1,60)
+58 ; date entered
SET DGFDA(33.11,IENS,.06)=EDITTS
+59 ; authorized by
IF $PIECE(DATASTR,U,4)'=""
SET DGFDA(33.11,IENS,.07)=$EXTRACT($PIECE(DATASTR,U,4),1,60)
+60 ; facility
SET DGFDA(33.11,IENS,.08)=$PIECE(DATASTR,U,8)
+61 ; creation date
IF +$PIECE(DATASTR,U,9)>0
SET DGFDA(33.11,IENS,.09)=$PIECE(DATASTR,U,9)
+62 DO FILE^DIE(,"DGFDA","DGERR")
+63 IF $DATA(DGERR)
SET RES="0^"_$GET(DGERR("DIERR",1,"TEXT",1))
+64 ;
FILAUTHX ; exit point
+1 ; unlock entry
+2 DO UNLOCK(IEN33)
+3 QUIT RES
+4 ;
FILDEN(DGDFN,DATASTR) ; file denied authorization request into file 33
+1 ;
+2 ; creates new entry in sub-file 33.03, then files data passed in DATASTR
+3 ; will only file data into an existing top level entry in file 33
+4 ;
+5 ; DGDFN - patient DFN
+6 ; DATASTR - string delimited by "^", as follows:
+7 ; p1 = date request submitted
+8 ; p2 = authorization comment (rejection reason)
+9 ; p3 = entered by (name)
+10 ; p4 = facility (file 4 ien)
+11 ; p5 = request creation date / time
+12 ; p6 = edit date / time
+13 ;
+14 ; returns 1 on success, "0 ^ [error message]" on failure
+15 ;
+16 NEW DGERR,DGFDA,EDITTS,IEN33,IENS
+17 ;
+18 IF +$GET(DGDFN)'>0
QUIT "0^Invalid DFN"
+19 ; get file 33 ien to file data into
+20 SET IEN33=+$ORDER(^DGOTH(33,"B",DGDFN,""))
IF IEN33'>0
QUIT "0^Unable to find an entry in file 33 for this patient"
+21 ; try to lock entry
+22 IF '$$LOCK(IEN33)
QUIT "0^Unable to lock entry in file 33 (ien = "_IEN33_")"
+23 SET RES=1
SET IENS="+1,"_IEN33_","
+24 SET EDITTS=$PIECE(DATASTR,U,6)
IF +EDITTS'>0
SET EDITTS=$$NOW^XLFDT()
+25 ; get the next available sequence number
+26 SET DGFDA(33.03,IENS,.01)=$ORDER(^DGOTH(33,IEN33,3,"B",""),-1)+1
+27 ;
+28 ; date request submitted
IF +$PIECE(DATASTR,U)
SET DGFDA(33.03,IENS,.02)=$PIECE(DATASTR,U)
+29 ; auth. comment
IF $PIECE(DATASTR,U,2)'=""
SET DGFDA(33.03,IENS,.03)=$EXTRACT($PIECE(DATASTR,U,2),1,60)
+30 ; entered by
SET DGFDA(33.03,IENS,.04)=$EXTRACT($PIECE(DATASTR,U,3),1,60)
+31 ; date /time entered
SET DGFDA(33.03,IENS,.05)=EDITTS
+32 ; facility
SET DGFDA(33.03,IENS,.06)=$PIECE(DATASTR,U,4)
+33 ; creation date / time
IF +$PIECE(DATASTR,U,5)
SET DGFDA(33.03,IENS,.07)=$PIECE(DATASTR,U,5)
+34 DO UPDATE^DIE(,"DGFDA",,"DGERR")
+35 DO UNLOCK(IEN33)
+36 IF $DATA(DGERR)
QUIT "0^"_$GET(DGERR("DIERR",1,"TEXT",1))
+37 QUIT 1
+38 ;
FILPEND(DGDFN,DATASTR) ; file pending authorization request into file 33
+1 ;
+2 ; files data passed in DATASTR into file 33 (top level)
+3 ; will only file data into an existing top level entry in file 33
+4 ;
+5 ; DGDFN - patient DFN
+6 ; DATASTR - string delimited by "^", as follows:
+7 ; p1 = pending request?(0 = no, 1 = yes)
+8 ; p2 = date request submitted
+9 ; p3 = entered by (name)
+10 ; p4 = facility (file 4 ien)
+11 ; p5 = creation date /time
+12 ; p6 = edit date / time
+13 ; *** setting DATASTR to "0^^^^^^" would delete existing pending request ***
+14 ;
+15 ; returns 1 on success, "0 ^ [error message]" on failure
+16 ;
+17 NEW DGERR,DGFDA,EDITTS,IEN33,IENS,PND
+18 ;
+19 IF +$GET(DGDFN)'>0
QUIT "0^Invalid DFN"
+20 ; get file 33 ien to file data into
+21 SET IEN33=+$ORDER(^DGOTH(33,"B",DGDFN,""))
IF IEN33'>0
QUIT "0^Unable to find an entry in file 33 for this patient"
+22 ; try to lock entry
+23 IF '$$LOCK(IEN33)
QUIT "0^Unable to lock entry in file 33 (ien = "_IEN33_")"
+24 SET IENS=IEN33_","
+25 ; pending request?
SET PND=+$PIECE(DATASTR,U)
+26 SET EDITTS=$PIECE(DATASTR,U,6)
IF PND
IF +EDITTS'>0
SET EDITTS=$$NOW^XLFDT()
+27 SET DGFDA(33,IENS,.07)=PND
+28 ; pending request date
SET DGFDA(33,IENS,.03)=$PIECE(DATASTR,U,2)
+29 ; pending req. entered by
SET DGFDA(33,IENS,.04)=$EXTRACT($PIECE(DATASTR,U,3),1,60)
+30 ; pending req. date entered /edited
SET DGFDA(33,IENS,.05)=EDITTS
+31 ; pending req. facility
SET DGFDA(33,IENS,.06)=$PIECE(DATASTR,U,4)
+32 ; creation date / time
SET DGFDA(33,IENS,.08)=$PIECE(DATASTR,U,5)
+33 DO FILE^DIE(,"DGFDA","DGERR")
+34 DO UNLOCK(IEN33)
+35 IF $DATA(DGERR)
QUIT "0^"_$GET(DGERR("DIERR",1,"TEXT",1))
+36 QUIT 1
+37 ;
GETPEND(DGDFN) ; get pending authorization request data from file 33
+1 ;
+2 ; DGDFN - patient DFN
+3 ;
+4 ; if there's no pending request, returns 0
+5 ; if error was encountered, returns "-1 ^ error message"
+6 ; if there is a pending request, returns the following string:
+7 ; "1 ^ pending request date ^ entered by (name) ^ date entered / edited ^ facility (station #) ^ creation date / time"
+8 ;
+9 NEW DGERR,DGFDA,IEN33,IENS,RES
+10 ;
+11 IF +$GET(DGDFN)'>0
QUIT "-1^Invalid DFN"
+12 ; get file 33 ien to get data from
+13 SET IEN33=+$ORDER(^DGOTH(33,"B",DGDFN,""))
IF IEN33'>0
QUIT "-1^Unable to find an entry in file 33 for this patient"
+14 SET IENS=IEN33_","
+15 DO GETS^DIQ(33,IENS,".03:.08","I","DGFDA","DGERR")
+16 IF $DATA(DGERR)
QUIT "-1^"_$GET(DGERR("DIERR",1,"TEXT",1))
+17 SET RES=+DGFDA(33,IENS,.07,"I")
IF 'RES
QUIT RES
+18 SET $PIECE(RES,U,2)=+DGFDA(33,IENS,.03,"I")
+19 SET $PIECE(RES,U,3)=DGFDA(33,IENS,.04,"I")
+20 SET $PIECE(RES,U,4)=+DGFDA(33,IENS,.05,"I")
+21 SET $PIECE(RES,U,5)=$$STA^XUAF4(+DGFDA(33,IENS,.06,"I"))
+22 SET $PIECE(RES,U,6)=+DGFDA(33,IENS,.08,"I")
+23 QUIT RES
+24 ;
GETAUTH(DGIEN33,DGIEN365,DGIEN90) ; get authorized 90 day period data from file 33
+1 ;
+2 ; DGIEN33 - ien in file 33
+3 ; DGIEN365 - ien in sub-file 33.01
+4 ; DGIEN90 - ien in sub-file 33.11
+5 ;
+6 ; if error was encountered, returns "-1 ^ error message"
+7 ; otherwise returns the following "^"-delimited string:
+8 ; p1 - 365 day period number
+9 ; p2 - 90 day period number
+10 ; p3 - start date (internal FM)
+11 ; p4 - date request submitted (internal FM)
+12 ; p5 - authorization received date (internal FM)
+13 ; p6 - entered / edited by (name)
+14 ; p7 - date entered / edited (internal FM)
+15 ; p8 - authorized by (name)
+16 ; p9 - facility (station #)
+17 ; p10 - creation date /time (internal FM)
+18 ;
+19 NEW DGERR,DGFDA,IENS,NUM365,RES,Z
+20 ;
+21 IF +$GET(DGIEN33)'>0
QUIT "-1^Invalid file 33 ien"
+22 IF +$GET(DGIEN365)'>0
QUIT "-1^Invalid sub-file 33.01 ien"
+23 IF +$GET(DGIEN90)'>0
QUIT "-1^Invalid sub-file 33.11 ien"
+24 SET IENS=DGIEN365_","_DGIEN33_","
+25 SET NUM365=$$GET1^DIQ(33.01,IENS,.01,"I",,"DGERR")
+26 IF $DATA(DGERR)
QUIT "-1^"_$GET(DGERR("DIERR",1,"TEXT",1))
+27 SET IENS=DGIEN90_","_IENS
+28 DO GETS^DIQ(33.11,IENS,"*","I","DGFDA","DGERR")
+29 IF $DATA(DGERR)
QUIT "-1^"_$GET(DGERR("DIERR",1,"TEXT",1))
+30 FOR Z=1:1:9
Begin DoDot:1
+31 IF Z=8
SET $PIECE(RES,U,Z)=$$STA^XUAF4($GET(DGFDA(33.11,IENS,Z/100,"I")))
QUIT
+32 SET $PIECE(RES,U,Z)=$GET(DGFDA(33.11,IENS,Z/100,"I"))
End DoDot:1
+33 SET RES=NUM365_U_RES
+34 QUIT RES
+35 ;
GETDEN(DGIEN33,DENIEN) ; get denied authorization request data from file 33
+1 ;
+2 ; DGIEN33 - ien in file 33
+3 ; DENIEN - ien in sub-file 33.03
+4 ;
+5 ; if error was encountered, returns "-1 ^ error message"
+6 ; otherwise returns the following "^"-delimited string:
+7 ; p1 - sequence number
+8 ; p2 - date request submitted (internal FM)
+9 ; p3 - authorization comment
+10 ; p4 - entered by (name)
+11 ; p5 - date entered (internal FM)
+12 ; p6 - facility (station #)
+13 ; p7 - creation date / time
+14 ;
+15 NEW DGERR,DGFDA,IENS,RES,Z
+16 ;
+17 IF +$GET(DGIEN33)'>0
QUIT "-1^Invalid file 33 ien"
+18 IF +$GET(DENIEN)'>0
QUIT "-1^Invalid sub-file 33.03 ien"
+19 SET IENS=DENIEN_","_DGIEN33_","
+20 DO GETS^DIQ(33.03,IENS,"*","I","DGFDA","DGERR")
+21 IF $DATA(DGERR)
QUIT "-1^"_$GET(DGERR("DIERR",1,"TEXT",1))
+22 FOR Z=1:1:7
Begin DoDot:1
+23 IF Z=6
SET $PIECE(RES,U,Z)=$$STA^XUAF4($GET(DGFDA(33.03,IENS,Z/100,"I")))
QUIT
+24 SET $PIECE(RES,U,Z)=$GET(DGFDA(33.03,IENS,Z/100,"I"))
End DoDot:1
+25 QUIT RES
