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

MBAAMDAL.m

Go to the documentation of this file. 
  1. MBAAMDAL ;OIT-PD/VSL - FILE ACCESS DAL ;02/10/2016
  1.  ;;1.0;Scheduling Calendar View;**1,7**;Feb 13, 2015;Build 16
  1.  ;
  1. GETREC(RETURN,IFN,FILE,FLDS,SFILES,INT,EXT,REZ,SD) ;
  1.  ; Input Variables
  1.  ; RETURN - RETURN results passed by reference
  1.  ; IFN - Internal Entry Number to the Files passed in (File 2 or File 44)
  1.  ; FILE - File #
  1.  ; FLDS = Array of FLDS
  1.  ; SFILES - Array of Sub-files
  1.  ; INT - Internal values returned
  1.  ; EXT - External values returned
  1.  ; REZ - Resolve field names instead of those peck numbers
  1.  ; SD - Date.Time if you only want one appointment in particular
  1.  ;      Date if you want all appointment on a give date
  1.  ;      or nothing if you want all appointments from today forward
  1.  ;
  1.  ; Get one record and specified subfiles from a file Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT, MBAA PATIENT PENDING APPT
  1.  N STRF,FLD,FLAG,C,SFILE,IFLD,REC,SFLDN,SKIPSF
  1.  S STRF=""
  1.  S IFLD=""
  1.  F  S IFLD=$O(FLDS(IFLD)) Q:IFLD=""  S STRF=STRF_$S(STRF="":"",1:";")_IFLD
  1.  S SFILE=""
  1.  ;
  1.  ; want to skip subfile 2.98 so it can be done differently.  no need to pull in all appointments for a patient since the beginning of time.
  1.  F  S SFILE=$O(SFILES(SFILE)) Q:SFILE=""  I $G(SFILES(SFILE,"F"))'=2.98 S STRF=STRF_$S(STRF="":"",1:";")_SFILE_"*"
  1.  ;
  1.  S FLD="",FLAG=""
  1.  S:$G(INT) FLAG=FLAG_"I" ;Returns Internal values
  1.  S:$G(EXT) FLAG=FLAG_"E" ;Returns External values
  1.  S:$G(REZ) FLAG=FLAG_"R" ;Resolves field numbers to field names
  1.  ;
  1.  D GETS^DIQ(FILE,IFN,STRF,FLAG,"REC")
  1.  ;
  1.  I $G(SFILES(1900,"F"))=2.98 D GETRECA  ;  this one we'll treat differently cause it can be huge and want to use a screen
  1.  ;
  1.  F  S FLD=$O(REC(FILE,""_IFN_",",FLD)) Q:FLD=""  D
  1.  . S:FLAG=""!(FLAG="R") RETURN(FLD)=REC(FILE,""_IFN_",",FLD)
  1.  . S:FLAG["I" RETURN(FLD)=REC(FILE,""_IFN_",",FLD,"I")
  1.  . S:FLAG["E" RETURN(FLD)=$S($L($G(RETURN(FLD)))>0:RETURN(FLD)_U,1:"")_REC(FILE,""_IFN_",",FLD,"E")
  1.  ;
  1.  S SFILE=""
  1.  F  S SFILE=$O(SFILES(SFILE)) Q:SFILE=""  D
  1.  . S SFLDN=$S(FLAG["R":SFILES(SFILE,"N"),1:SFILE)
  1.  . D GETSREC(.RETURN,.REC,SFILES(SFILE,"F"),SFLDN,FLAG)
  1.  K FLAG,FILE,STRF
  1.  Q
  1.  ;
  1. GETSREC(RETURN,REC,SFILE,SFLD,FLAG) ; Get record subfile data Called by RPC MBAA APPOINTMENT MAKE, MBAA RPC: MBAA CANCEL APPOINTMENT, MBAA PATIENT PENDING APPT
  1.  N IDX,ID S FLD="",IDX=""
  1.  F  S IDX=$O(REC(SFILE,IDX)) Q:IDX=""  D
  1.  . F  S FLD=$O(REC(SFILE,IDX,FLD)) Q:FLD=""  D
  1.  . . S ID=$P(IDX,",",1)
  1.  . . S:FLAG=""!(FLAG="R") RETURN(SFLD,ID,FLD)=REC(SFILE,IDX,FLD)
  1.  . . S:FLAG["I" RETURN(SFLD,ID,FLD)=REC(SFILE,IDX,FLD,"I")
  1.  . . S:FLAG["E" RETURN(SFLD,ID,FLD)=$S($L($G(RETURN(SFLD,ID,FLD)))>0:RETURN(SFLD,ID,FLD)_U,1:"")_REC(SFILE,IDX,FLD,"E")
  1.  . . N SI S SI=0
  1.  . . F  S SI=$O(REC(SFILE,IDX,FLD,SI)) Q:SI=""!(SI="I")!(SI="E")  D
  1.  . . . S RETURN(SFLD,ID,FLD,SI)=REC(SFILE,IDX,FLD,SI),RETURN(SFLD,ID,FLD)=""
  1.  Q
  1.  ;code below is not being used in the initial release of MBAA. It will be released at a later date in a future release of MBAA
  1.  ;LSTSCOD(FILE,FIELD,LIST) ;List codes in SET OF CODE fields
  1.  ; ;FILE = file number
  1.  ; ;FIELD = field number
  1.  ; ;LIST = output array:
  1.  ; ;   LIST(#)=code^display_name
  1.  ; N SET,NODE,CODE,NAME,I,COUNT
  1.  ; S SET=$$GET1^DID(FILE,FIELD,,"POINTER")
  1.  ; S COUNT=1
  1.  ; F I=1:1:$L(SET,";") D
  1.  ; . S NODE=$P(SET,";",I)
  1.  ; . S CODE=$P(NODE,":")
  1.  ; . Q:CODE=""
  1.  ; . S NAME=$P(NODE,":",2)
  1.  ; . S LIST(COUNT)=CODE_"^"_NAME
  1.  ; . S COUNT=COUNT+1
  1.  ; S LIST(0)=COUNT-1
  1.  ; Q
  1.  ;
  1. GETRECA ;MBAA*1*7;will use SCREEN to get only the data that is needed from sub-file 2.98
  1.  ; The orignal code pulled every appointment the patient ever had by doing one inquiry on the patient file.
  1.  ; It returned so many that it had to store in a global and then parse the global to return everything > than yesterday
  1.  ; and then potentially further parse when it gets back to calling routine which may have only wanted one to cancel
  1.  ; Instead of one DIQ call on the patient, it has been changed to a LIST^DIC call using a SCREEN on the sub-file which gets just what you want.
  1.  ;
  1.  ; This was rewritten to get a specific appointment for cancellation (SD would be a date.time in FileMan format)
  1.  ;  Or
  1.  ; It will give everything on a certain date (SD will be just a date, no time)
  1.  ;  Or
  1.  ; everything from today forward if no date passed in
  1.  ; 
  1.  ; Will it ever want past appointments?
  1.  ;
  1.  N ERROR,TARGET,APT,IENS,LP,SCREEN
  1.  S SCREEN=$$SCREEN($G(SD))
  1.  S IENS=","_IFN_","
  1.  D LIST^DIC(2.98,IENS,".001;@","EI",,,,,SCREEN,,"TARGET","ERROR")
  1.  ;
  1.  ; returns something like this so loop through it
  1.  ;TARGET("DILIST",0)="97^*^0^"
  1.  ;TARGET("DILIST",2,1)=3140826.09
  1.  ;TARGET("DILIST",2,2)=3140925.1
  1.  ;TARGET("DILIST",2,3)=3141023.08
  1.  ;
  1.  ; Make sure we have a bite
  1.  I '$D(TARGET("DILIST",2,1)) Q
  1.  ;
  1.  ; Now, loop through that list and get the deets
  1.  S LP=0 F  S LP=$O(TARGET("DILIST",2,LP)) Q:LP=""  D
  1.  . S IENS=TARGET("DILIST",2,LP)_","_IFN_","
  1.  . K APT   ; mant to make sure it's clean going in
  1.  . D GETS^DIQ(2.98,IENS,"*",FLAG,"APT")    ; might need to revisit the * but maybe not.  GETREC above also grabs all fields in a subfile.
  1.  . M REC=APT  ; save off the appointment it's returning
  1.  Q
  1.  ;
  1. SCREEN(SD) ;
  1.  ; SCREEN will either be I Y=SD (FileMan format)
  1.  ; or I $P(Y,".")=SD
  1.  ; or I Y>(TODAY - 1 second) (FileMan Format)
  1.  I $P($G(SD),".",2) Q "I Y="_SD
  1.  I $G(SD) Q "I $P(Y,""."")="_SD
  1.  Q "I Y>"_$$FMADD^XLFDT(DT,0,0,0,-1)