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

DGOTHD2.m

Go to the documentation of this file.
  1. DGOTHD2 ;SLC/SS,RM,RED - OTHD (OTHER THAN HONORABLE DISCHARGE) APIs ;12/27/17
  1. ;;5.3;Registration;**952**;Aug 13, 1993;Build 160
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ; Last Edited: SHRPE/RED - May 2, 2018 15:11
  1. ;
  1. ; IA: 10103 ^XLFDT (supported) - [$$FMADD^XLFDT, $$FMTE^XLFDT , $$NOW^XLFDT]
  1. ; 10015 ^DIQ (supported) - [GETS^DIQ]
  1. ; 10026 ^DIR (supported)
  1. ; 2053 ^DIE (supported) - [FILE^DIE, UPDATE^DIE]
  1. ; 10000 ^%DTC (supported) - [NOW^%DTC]
  1. Q
  1. ;
  1. ;create the new entry in file #33 (OTH ELIGIBILITY)
  1. ;DGDFN - patient's IEN
  1. ;returns
  1. ;IEN of the file #33
  1. ;or -1^error message
  1. CROTHENT(DGDFN) ;
  1. N DGVALS,DGIEN33
  1. I $$CHCKPAT(DGDFN)'>0 Q -2 ;patient does not exist
  1. S DGVALS(.01)=DGDFN
  1. S DGVALS(.02)=1 ;set to ACTIVE
  1. S DGIEN=$$INSREC(33,"",.DGVALS)
  1. ;create subfile 2 - ELIGIBILITY CHANGES (Multiple-33.02)
  1. D CRTEELCH^DGOTHEL(DGDFN,$$HASENTRY^DGOTHD2(DGDFN),$$NOW^XLFDT())
  1. Q DGIEN
  1. ;
  1. ;Get the user's current facility number. If not found, it will
  1. ;return the facility number of the primary facility.
  1. GETSITE(DUZ) ;
  1. ;Input:
  1. ; DUZ array, pass by reference
  1. ;Output:
  1. ; Function Value - facility number
  1. N FACILITY
  1. S FACILITY=""
  1. S:DUZ'=.5 FACILITY=DUZ(2)
  1. I 'FACILITY S FACILITY=+$$SITE^VASITE()
  1. Q FACILITY
  1. ;
  1. ;check if the patient has 2nd period authorization
  1. ;DGIEN33 - ien file #33
  1. ;DGI3301 - ien subfile #33.01
  1. ;CLCKNO - 90 days clock #
  1. HAS2AUTH(DGIEN33,DGI3301,CLCKNO) ;
  1. N DGIEN90,DGRETDAT
  1. S DGIEN90=$$CHCK90(DGIEN33,DGI3301,CLCKNO)
  1. I DGIEN90'>0 Q -1 ; OTH clock entry in the file #33 doesn't exist
  1. S DGRETDAT=$G(^DGOTH(33,DGIEN33,1,DGI3301,1,DGIEN90,0))
  1. Q $P(DGRETDAT,U,3,4)
  1. ;
  1. ;does the patient have clock?
  1. ;DGDFN - patient IEN
  1. HASENTRY(DGDFN) ;
  1. Q +$O(^DGOTH(33,"B",DGDFN,0))
  1. ;
  1. ;how many 365 days clock the patient has?
  1. ;DGIEN33 - ien of #33
  1. CLCKS365(DGIEN33) ;
  1. Q $O(^DGOTH(33,DGIEN33,1,"B",99),-1)
  1. ;
  1. ;returns
  1. ;-1 : if OTH clock entry in the file #33 doesn't exist
  1. ;0 : if 365 days clock with the number CLCKNO doesn't exist
  1. ;>0 : IEN of the 365 days clock with the number CLCKNO
  1. CHCK365(DGIEN33,CLCKNO) ;
  1. I +$D(^DGOTH(33,DGIEN33,0))'>0 Q -1 ;clock doesn't exist
  1. Q +$O(^DGOTH(33,DGIEN33,1,"B",CLCKNO,0))
  1. ;
  1. ;returns
  1. ;-1 : if OTH clock entry in the file #33 doesn't exist
  1. ;0 : if 90 days clock with the number CLCKNO doesn't exist
  1. ;>0 : IEN of the 90 days clock with the number CLCKNO
  1. CHCK90(DGIEN33,DGI3301,CLCKNO) ;
  1. I +$D(^DGOTH(33,DGIEN33,0))'>0 Q -1 ;clock doesn't exist
  1. I +$D(^DGOTH(33,DGIEN33,1,DGI3301,0))'>0 Q -1 ;clock doesn't exist
  1. Q +$O(^DGOTH(33,DGIEN33,1,DGI3301,1,"B",CLCKNO,0))
  1. ;check DFN
  1. CHCKPAT(DGDFN) ;
  1. Q +$D(^DPT(DGDFN,0))
  1. ;
  1. ;get patient IEN by ien of the file #33
  1. GETPAT(DGIEN33) ;
  1. Q $P($G(^DGOTH(33,DGIEN33,0)),U)
  1. ;
  1. ;input:
  1. ;DGPROM - prompt text
  1. ;DGDFVL - default value (optional)
  1. ;returns:
  1. ; "response^"
  1. PROMPT(DGPROM,DGDFVL) ;
  1. N DGRET,DIR,X,Y,DIRUT,DIROUT,DTOUT,DUOUT
  1. S DGRET="^"
  1. S DIR(0)="F^::2",DIR("A")=DGPROM
  1. I $L($G(DGDFVL))>0 S DIR("B")=$G(DGDFVL)
  1. D ^DIR I $D(DIRUT) Q "^"
  1. S $P(DGRET,U)=Y
  1. Q DGRET
  1. ;
  1. ;This procedure is used to perform a patient lookup for an existing patient in the (#33) file.
  1. ;Parameters:
  1. ; None
  1. ;Returns:
  1. ; in DGPAT array where
  1. ; DGPAT = IEN of patient in PATIENT (#33) file on success, -1 on failure
  1. ; DGPAT(0) = zero node of entry selected
  1. ; return value IEN of patient in PATIENT (#33) file on success, -1 on failure
  1. SELPAT(DGPAT) ;
  1. ;- int input vars for ^DIC call
  1. N DIC,DTOUT,DUPOT,X,Y
  1. S DIC="^DGOTH(33,",DIC(0)="AEMQZV"
  1. ;screen out all that are not ACTIVE
  1. S DIC("S")="I $P(^(0),U,2)=1"
  1. ;- lookup patient
  1. D ^DIC K DIC
  1. ;- result of lookup
  1. S DGPAT=Y
  1. ;- if success, setup return array using output vars from ^DIC call
  1. I (+DGPAT>0) D Q +Y
  1. . S DGPAT=+Y ;patient ien
  1. . S DGPAT(0)=$G(Y(0)) ;zero node of patient in (#33) file
  1. Q -1
  1. ;
  1. ;/**
  1. ;Creates a new entry (or node for multiple with .01 field)
  1. ;
  1. ;DGFILE - file/subfile number
  1. ;DGIEN - ien of the parent file entry in which the new subfile entry will be inserted
  1. ;DGZFDA - array with values for the fields
  1. ; format for DGZFDA:
  1. ; DGZFDA(.01)=value for #.01 field
  1. ; DGZFDA(3)=value for #3 field
  1. ;DGRECNO -(optional) specify IEN if you want specific value
  1. ; Note: "" then the system will assign the entry number itself.
  1. ;DGFLGS - FLAGS parameter for UPDATE^DIE
  1. ;DGLCKGL - fully specified global reference to lock
  1. ;DGLCKTM - time out for LOCK, if LOCKTIME=0 then the function will not lock the file
  1. ;DGNEWRE - optional, flag = if 1 then allow to create a new top level record
  1. ;
  1. ;output :
  1. ; positive number - record # created
  1. ; <=0 - failure^error message
  1. ;
  1. ;Example:
  1. ;top level:
  1. ;S DGVALS(.01)="OTHD" W $$INSREC^DG53952(8.1,"",.DGVALS,,,,,1)
  1. ;2nd level:
  1. ;K DGVALS S DGVALS(.01)=1 W $$INSREC^DGOTHD2(33.01,"8",.DGVALS)
  1. ;3rd level:
  1. ;K DGVALS S DGVALS(.01)=1 W $$INSREC^DGOTHD2(33.11,"1,8",.DGVALS)
  1. INSREC(DGFILE,DGIEN,DGZFDA,DGRECNO,DGFLGS,DGLCKGL,DGLCKTM,DGNEWRE) ;*/
  1. I ('$G(DGFILE)) Q "0^Invalid parameter"
  1. I +$G(DGNEWRE)=0 I $G(DGRECNO)>0,'$G(DGIEN) Q "0^Invalid parameter"
  1. N DGSSI,DGIENS,DGERR,DGFDA,DIERR
  1. N DGLOCK S DGLOCK=0
  1. I '$G(DGRECNO) N DGRECNO S DGRECNO=$G(DGRECNO)
  1. I DGIEN'="" S DGIENS="+1,"_DGIEN_"," I $L(DGRECNO)>0 S DGSSI(1)=+DGRECNO
  1. I DGIEN="" S DGIENS="+1," I $L(DGRECNO)>0 S DGSSI(1)=+DGRECNO
  1. M DGFDA(DGFILE,DGIENS)=DGZFDA
  1. I $L($G(DGLCKGL)) L +@DGLCKGL:(+$G(DGLCKTM)) S DGLOCK=$T I 'DGLOCK Q -2 ;lock failure
  1. D UPDATE^DIE($G(DGFLGS),"DGFDA","DGSSI","DGERR")
  1. I DGLOCK L -@DGLCKGL
  1. I $D(DGERR) Q "-1^"_$G(DGERR("DIERR",1,"TEXT",1),"Update Error")
  1. Q +$G(DGSSI(1))
  1. ;
  1. HELP3 ;display help text for 1st 90-Day period
  1. I $G(Y)<1,X'="?",X'="??" W !," You have entered an invalid date, please enter a valid date." Q
  1. W !," The date entered cannot be more than 90 days in the past."
  1. W !," A future date cannot be entered."
  1. Q
  1. ;